খালি সারি মুছে ফেলতে এক্সেল ম্যাক্রো বন্ধ করা হয় না

Question

আমি কিভাবে নির্দিষ্ট সারির পরে এটি বন্ধ করতে পারি?

আমি একটি ভিবিএ কোর্স গ্রহণ করেছি এবং আমার শিক্ষক খালি সারি মুছে ফেলার ব্যাখ্যা করেছেন। আমি এখন এই জায়গায় রাখা চেষ্টা করছি কিন্তু আমার ম্যাক্রো থামানো হয় না। আমি ভেবেছিলাম আমি 200 সারিতে সীমাবদ্ধ ছিলাম।

আমি কিছু গুরুত্বপূর্ণ অনুপস্থিত করছি। কোন পয়েন্টার অনেক প্রশংসা।

Sub RemoveRows()
' Remove rows from last blank cell

Dim LastRow As Long
Dim ISEmpty As Long

'Count how many records in the list. This is done so that the Do loop has a finish point.
LastRow = Range("A200").End(xlUp).Row

'Start at the top of the list
Range("A1").Select

'Loop until the end of the list
Do While ActiveCell.Row < LastRow

'Assign number of non empty cells in the row
    ISEmpty = Application.CountA(ActiveCell.EntireRow)

'If ISEmpty = 0 then delete the row, if not move down a cell into the next row
        If ISEmpty = 0 Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
        End If

Loop

End Sub

Answer 1

'তালিকা শীর্ষে শুরু করুন

এটাই সমস্যা. সারি মুছে ফেলার সময়, সর্বদা তালিকার শেষের দিকে একটি অবিচ্ছিন্ন লুপ এড়াতে শুরু করুন।

কোড মাধ্যমে পদক্ষেপ। এটি জনবহুল কোষগুলির উপরে খালি সারি মুছে ফেলবে, তারপর ধাপে ধাপে নির্বাচিত জনসংখ্যা নির্বাচন করুন। তারপরে, এটি জনবহুল কক্ষগুলির নীচের খালি ঘর নির্বাচন করবে এবং সেই সারিটি মুছবে।

উদাহরণস্বরূপ, সারি 35 হলে, সারি 35 টি মুছে ফেলা হবে। কিন্তু নিচের সারিগুলি একটিকে সরানো হবে, তাই আপনি কখনই সারি 35 টি মুছে ফেলবেন না। মুছে ফেলার পরে, নির্বাচনটি এখনও সারি 35 তে বসায়। সুতরাং আপনার একটি অবিচ্ছিন্ন লুপ রয়েছে।

পরিবর্তে নীচে থেকে লুপ তৈরি করুন।

Option Explicit

Sub RemoveRows()
' Remove rows from last blank cell

Dim LastRow As Long
Dim ISEmpty As Long
Dim i As Long

'Count how many records in the list. This is done so that the Do loop has a finish point.
LastRow = Range("A200").End(xlUp).Row

'Start at the top of the list
For i = LastRow To 1 Step -1

'Assign number of non empty cells in the row
    ISEmpty = Application.CountA(Range("A" & i).EntireRow)

'If ISEmpty = 0 then delete the row, if not move up a cell into the previous row
        If ISEmpty = 0 Then
            Range("A" & i).EntireRow.Delete
        End If
Next i

End Sub

এটি সম্ভবত একটি আরো মার্জিত ভাবে সম্পন্ন করা যেতে পারে, কিন্তু এটি আশা করে আপনি একটি শুরু দেয়।

Comments

আমি আপনাকে এটা করতে প্রয়োজন ঠিক কি করা হয়েছে ধন্যবাদ, এবং আমার ইচ্ছা চিন্তা। আমি এখন আমার কর্ম শুরু যেখানে একটি ভাল বোঝার আছে।

— RocketGoal

Answer 2

উপরে ব্যবহারকারী হিসাবে এটি এই কোড আরো মার্জিত হয়। কিন্তু যদি আপনার 800+ লাইন থাকে তবে এটি কোনও কারণে স্মৃতিতে আঘাত করে।

Sub RemoveEmptyRows()
On Error Resume Next
    With ActiveSheet.Range(Cells(2, 1), Cells(Rows.Count, 1))
    .Value = .Value
    .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    End With
End Sub

আরও একবার গিয়েছিলাম এবং এটি সত্যিই দ্রুত করে তোলে: এটা দেখ:

Sub RemoveEmptyRows()
On Error Resume Next
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
End Sub

Comments

আমি আসলে এটি করার একটি তাত্ক্ষণিক উপায় খুঁজে বের করেছি ... বিশেষ কোষগুলির সাথে কাজ করুন এবং ক্লিয়ারেন্টগুলি করুন। খুব সহজ. আপনি প্রতি বলতে পরিসীমা বিশেষ কোষ সঙ্গে করতে পারে।

— DeerSpotter