如何有效地抑制excelvba中選定列中的所有空行？

我找到了一些 Q/A 來洗掉所選列中包含空單元格的行，例如

后：

uj5u.com熱心網友回復：

洗掉空行范圍

• 這是一個基本的例子。感謝您對效率的反饋。

Option Explicit

Sub DeleteRowsOfEmptyColumn()
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    Dim crg As Range: Set crg = Selection.EntireColumn ' Columns Range
    Dim srg As Range: Set srg = Intersect(ws.UsedRange, crg) ' Source Range
    
    Dim drg As Range ' Delete Range
    Dim arg As Range ' Area Range
    Dim rrg As Range ' Row Range
    
    For Each arg In srg.Areas
        For Each rrg In arg.Rows
            If Application.CountA(rrg) = 0 Then
                If drg Is Nothing Then
                    Set drg = rrg
                Else
                    Set drg = Union(drg, rrg)
                End If
            End If
        Next rrg
    Next arg
    
    If Not drg Is Nothing Then drg.Delete
    
    Application.ScreenUpdating = True

    MsgBox "Rows deleted.", vbInformation

End Sub

uj5u.com熱心網友回復：

我正在從事類似的專案。我選擇將資料讀入一個陣列，然后處理陣列中的資料，從而顯著提高運行時間。這是我用來洗掉/轉換資料集的函式的副本：

    Option Explicit
Option Base 1
Public Function RemoveRowFromArray(Arr As Variant, Element As String, Col As Long) As Variant

Dim i, j, c, count As Long
Dim TempArr() As Variant

    For i = LBound(Arr, 1) To UBound(Arr, 1)                         ' looping through the columns to get desired value
        If Arr(i, Col) = Element Then
             count = count   1                                                   ' Counting the number of Elements in array / matrix
                    For j = i To (UBound(Arr, 1) - 1)                       ' Looping from the row where Element is found
                        For c = LBound(Arr, 2) To UBound(Arr, 2)    ' Moving all elements in row 1 row up
                                Arr(j, c) = Arr(j   1, c)
                        Next c
                    Next j
        End If
    Next i
    
    ' Populating TempArr to delete the last rows

ReDim TempArr((UBound(Arr, 1) - count), UBound(Arr, 2))

   For i = LBound(TempArr, 1) To UBound(TempArr, 1)
            For j = LBound(TempArr, 2) To UBound(TempArr, 2)
                    TempArr(i, j) = Arr(i, j)                                                 
            Next j
    Next i

    RemoveRowFromArray = TempArr
End Function

我對此進行了測驗，似乎效果很好。需要記住的幾個重要事項

Option Base 1 - 這很重要，當您在 VBA 中宣告 arr 時，它從索引 0 開始，當您從 Excel [arr = sheet1.Range("A:D")] 中的資料集中讀取 arr 時，arr 開始index 為 1，Option Base 1 將確保所有 arr 從 Index 1 開始。

函式變數是： Arr - 陣列/矩陣

元素 - 您希望搜索的字串（在您的情況下為空白）

Col - 是 Element 所在的列號。

uj5u.com熱心網友回復：

請嘗試下一個方法。它將處理列中的單元格選擇：

Sub DeleteRowsOfEmptyColumn()
    Dim sh As Excel.Worksheet: Set sh = ActiveSheet
    Dim col As Range: Set col = Selection.EntireColumn
    Dim area As Range: Set area = Intersect(sh.UsedRange, col)
    Dim areaV As Range
    On Error Resume Next
        Set areaV = area.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not areaV Is Nothing Then areaV.EntireRow.Delete   
End Sub

編輯：

下一個版本將處理許多單元格/列選擇：

Sub DeleteRowsOfEmptyColumn_bis()
    Dim sh As Excel.Worksheet: Set sh = ActiveSheet
    Dim col As Range: Set col = Selection.EntireColumn
    Dim i As Long
    Dim area As Range: Set area = Intersect(sh.UsedRange, col)
    Dim areaV As Range
    For i = 1 To area.Areas.count
        On Error Resume Next
            Set areaV = area.Areas(i).Columns(1).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        If Not areaV Is Nothing Then areaV.EntireRow.Delete: Set areaV = Nothing
    Next i
End Sub

標籤：擅长 vba 循环 优化 行

上一篇：如何修復For回圈和If條件在Bash腳本中不起作用

下一篇：用數字填充陣列的對角線元素