একটি খালি সারিতে পৌঁছানোর সময় ভিবিএ ম্যাক্রো বন্ধ করুন


0

আমি সম্প্রতি এক্সেল ২010 এর অধীনে কিছু কাজ সহজ করার জন্য ম্যাক্রো ব্যবহার করে চেষ্টা করেছি কারণ আমি দুর্ভাগ্যবশত বিশাল ডেটাবেঙ্কগুলির সাথে কাজ করছি।

আমি ইতোমধ্যেই কোডটি খুঁজে পেয়েছি যা আমাকে ডুপ্লিকেট সারিগুলিকে একত্রিত করতে এবং অনন্য ডেটা / মন্তব্যগুলিকে একত্রিত করার জন্য ধন্যবাদ, এই জীবন-সংরক্ষণের থ্রেডে ধন্যবাদ: এক্সেলের একক সারিতে একাধিক সারি থেকে মানগুলি কীভাবে একত্রিত করা যায়?

কোডটি আমার মতো একজন শিক্ষকের পক্ষে সহজ ছিল (আমি চাই এবং অন্ধকার কপি-পেস্টিংয়ের পরিবর্তে যা করছি তা বোঝার চেষ্টা করুন)। আমি যে সমস্যার সম্মুখীন হল সেটি হল যে ম্যাক্রো শেষ সারিতে থামবে বলে মনে হচ্ছে না এবং বাকি এক্সেল শীটটি পূরণ করা শেষ হয়।

4 থেকে 6 সারিতে দেখানো পছন্দসই ফলাফল প্রাপ্ত হয়েছিল, কিন্তু ২২ সারির শুরু ... image যাইহোক আপনি দেখতে পারেন যে ২২ সারিতে শুরু হওয়া ম্যাক্রো অ্যাডিং চালিয়ে যায় ";" 10 তম কলামে।

এখানে আমি যে কোডটি মানিয়েছি তা হল:

Sub merge_dupes_and_comments()
'define variables

Dim RowNum As Long, LastRow As Long

Application.ScreenUpdating = False

RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
Range("A2", Cells(LastRow, 10)).Select

For Each row In Selection
    With Cells
    'if OC number matches
    If Cells(RowNum, 2) = Cells(RowNum + 1, 2) Then
        'and if position and material match
        If Cells(RowNum, 4) = Cells(RowNum + 1, 4) Then
        If Cells(RowNum, 5) = Cells(RowNum + 1, 5) Then
        'move updated comments up next to the old comment and delete empty line
            Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)
            Rows(RowNum + 1).EntireRow.Delete
       End If
        End If
         End If
         End With

RowNum = RowNum + 1
Next row

Application.ScreenUpdating = True

End Sub

আমি নিশ্চিত নই কেন এটি বন্ধ হচ্ছে না এবং আমি নির্দিষ্ট ডেটা ইনপুট করতে চাই না কারণ আমি যে ডেটাবেসে কাজ করছি সেটি প্রতি সপ্তাহে পরিবর্তিত হয়।

আমি শেষ সারির হিসাবে পুনরায় সংজ্ঞায়িত করার চেষ্টা করেছি:

Dim LastRow As Long

With ThisWorkbook.Worksheets("MasterData") 'enter name of the sheet you're working on
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).row
    Else
        LastRow = 1
    End If

কিন্তু আমি কোন পরিবর্তন লক্ষ্য করেছি।

আমি কোন সাহায্যের জন্য কৃতজ্ঞ হবে!

অগ্রিম অনেক ধন্যবাদ, KuroNavi


যদি আপনি জানেন লুপ থেকে বেরিয়ে যেতে পারেন, বিবেচনা করুন exit for লুপ বিরতি আউট। এছাড়াও, আপনার উইথ সেলস স্টেটমেন্টটি আপনার কোডে ব্যবহৃত হচ্ছে না এবং আপনি এটি মুছে ফেলতে বিবেচনা করতে পারেন। কোষগুলি যখন আপনি প্রবেশ করেন তখন সেগুলি তৈরি করে। স্ট্যাটমেন্ট এটি সেলগুলি অনুমান করবে। এটা আগে লেখা ছিল।
LPChip

এছাড়াও, যদি আপনি CTRL-END টি চাপুন (আমার মনে হয় এটি কীবোর্ড শর্টকাটকি) শেষ সেলটিতে যাওয়ার জন্য, আপনি কোথায় শেষ করেন? আমার স্ক্রিপ্টটি নীচের দিকে খালি সারিগুলি রয়েছে যা আপনার স্ক্রিপ্টটিকে যাওয়ার প্রয়োজনের চেয়ে আরও বেশি করে নিয়ে যেতে পারে। এক্সেলের সাথে এক্সপোর্ট খুললে এটি আপনার পক্ষে সাধারণ এবং আপনার ডেটা এক্সপোর্ট হিসাবে মনে হয়। বিকল্পভাবে, এক-বারের মৃত্যুদণ্ডের জন্য একটি নতুন ম্যাক্রো তৈরি করুন, আপনার শেষ সারির কোডটি ঢোকান এবং কেবল করুন Cells(LastRow,1).Select এবং এটি যেখানে আপনি লাফান দেখুন। এটা 65535 সারি?
LPChip

হ্যালো, দ্রুত প্রতিক্রিয়ার জন্য এবং আমার পোস্টটি সঠিকভাবে ফর্ম্যাট করার জন্য আপনাকে ধন্যবাদ। আমার তথ্য প্রকৃতপক্ষে একটি এক্সপোর্ট করা হবে। আমি একটি পরিষ্কার নতুন ওয়ার্ক শীট তৈরি করেছি এবং এতে টেবিল অনুলিপি করেছি। যখন আমি ইনপুট করার চেষ্টা করেছিলাম Sub test() Dim LastRow As Long LastRow = Cells.SpecialCells(xlCellTypeLastCell).row Cells(LastRow, 1).Select End Sub আমি A31 উপর শেষ পর্যন্ত, যা প্রকৃতপক্ষে শেষ সারি। তবে যখন আমি আমার উপরের উল্লিখিত কোডটি পুনরায় চালু করি, তখনও আমি অতিরিক্ত খালি সারি এবং ";" দিয়ে শেষ করি। (দুঃখিত, আমি নতুনত্ব হিসাবে ফর্ম্যাটিংয়ের সাথে সংগ্রাম করছি ...)
KuroNavi

অবশ্যই এই ঘটবে। খালি সারি খালি সারি মিললে, আপনার ম্যাক্রো একটি সন্নিবেশ করানো হয়; সারি ২9, 30 ও 31 টি 3 খালি সারি আপনার ম্যাক্রোতে বিবেচিত হয় কারণ শেষ ঘরটি 31 তে চলে যায়, ২9 নয়। সুতরাং আপনি সারি খালি কিনা তা পরীক্ষা করতে চান। আমি আপনাকে একটি উত্তর লিখতে হবে।
LPChip

উত্তর:


0

আপনার শেষ সারিটি টেবিলের শেষ সারি নয়, তবে নীচের 3 টি খালি সারি রয়েছে যা পূরণ করা হয়; কারণ আপনার ম্যাক্রো এই লাইনটি ধারণ করে:

        Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)

এই কমান্ডটি মূলত বলছে: খালি লাইনের সাথে খালি লাইন যোগ করুন এবং পৃথক করুন;

কিন্তু আপনি খালি লাইন জন্য চেক করতে চান না। সুতরাং আপনার সাব নিম্নরূপ হতে হবে:

Sub merge_dupes_and_comments()
    'define variables
    Dim RowNum As Integer, LastRow As Integer, EmptyCells as Integer

    Application.ScreenUpdating = False

    RowNum = 2
    LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
    Range("A2", Cells(LastRow, 10)).Select

    For Each row In Selection
        'Do we have am empty row? If so exit the loop.
        'Lets count the amount of empty cells on the row.
        EmptyCells=0
        For c = 1 to 10   
            if Cells(RowNum,c) = "" then EmptyCells = EmptyCells+1
        Next c

        'If we find more than 9 empty cells, assume the row is empty, and exit the loop.
        if EmptyCells > 9 then exit for

        'Lets continue the duplicate checking
        'if OC number matches
        'and if position and material match
        If Cells(RowNum, 2) = Cells(RowNum + 1, 2) AND _
           Cells(RowNum, 4) = Cells(RowNum + 1, 4) AND _
           Cells(RowNum, 5) = Cells(RowNum + 1, 5) Then
           'move updated comments up next to the old comment and delete empty line
            Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)
            Rows(RowNum + 1).EntireRow.Delete
       End If

    RowNum = RowNum + 1
Next row

Application.ScreenUpdating = True

End Sub

আমি আপনার ভেরিয়েবলগুলির লম্বা থেকে পূর্ণসংখ্যার ঘোষণাটি পরিবর্তন করেছি, কারণ আপনি সম্পূর্ণ সংখ্যার সাথে কাজ করছেন যা পূর্ণসংখ্যার সীমানা অতিক্রম করবে না, তাই কম মেমরি গ্রহণ করবে।


1
আপনাকে অনেক অনেক ধন্যবাদ! আমি এখন কোথায় গিয়েছিলাম তা আমি দেখতে পাচ্ছি - আপনি একটি বাস্তব জীবন বাঁচান এবং আপনার অনন্ত কৃতজ্ঞতা আছে!
KuroNavi
আমাদের সাইট ব্যবহার করে, আপনি স্বীকার করেছেন যে আপনি আমাদের কুকি নীতি এবং গোপনীয়তা নীতিটি পড়েছেন এবং বুঝতে পেরেছেন ।
Licensed under cc by-sa 3.0 with attribution required.