[分享] 刪除指定條件列資料

Andy2483

各位前輩好
分享多年前 准提部林前輩指導的範例,裡面有多種方法,後學駑鈍,現在才矇懂
趁此主題分享做學習,謝謝論壇,謝謝前輩
歡迎各位在主題裡一起學習,裡面有基本的陣列觀念,還有很多技巧 !

20130802a01(刪除指定條件列資料).rar (75.67 KB)

下載次數: 10

2023-2-14 09:16

執行前:

下載 (120.19 KB)

2023-2-14 09:20

執行結果:

下載 (118.62 KB)

2023-2-14 09:20

Option Base 1
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/option-base-statement
Sub Option_Base_陳述式_基底測試()
    ReDim Arr(1)
    MsgBox LBound(Arr)
    '↑加了 這行 Option Base 1 ,陣列的起始索引號會是 1 (原預設值是 0)
End Sub
Sub 加法1()
    Dim Arr()
    '↑宣告Arr是還沒宣告維度的陣列
    ST = Timer
    '↑令ST是 現在時間
    With ActiveSheet
    '↑以下是關於現用工作表的程序
        er = .UsedRange.Rows.Count
        '↑令er是數字 使用的儲存格擴展為最小方正範圍的列數
        ec = 27
        '↑令ec是數字 27
        For r = 1 To er
        '↑設順迴圈!r從1 到 er變數
            If Application.WorksheetFunction.CountIf(Range("A" & r & ":AA" & r), "EC1-") = 0 Then
            '↑如果以 WorksheetFunction.CountIf 方法回傳值是 0 ??
            'A欄r變數列儲存格到 AA欄r變數列儲存格,此範圍儲存格值是 "EC1-" 字串的 儲存格數量
            'https://learn.microsoft.com/zh-tw/office/vba/api/excel.worksheetfunction.countif
                N = N + 1
                '↑令N變數累加 1
                ReDim Preserve Arr(27, N)
                '↑令陣列擴充欄數至N欄!並保留原陣列值
                'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/redim-statement
                For c = 1 To 27
                '↑設順迴圈!c從1 到 27
                    Arr(c, N) = .Cells(r, c).Value
                    '↑令c列N欄Arr陣列值是 r列c欄儲存格值
                Next c
            End If
        Next r
        .UsedRange.ClearContents
        '↑令使用的儲存格擴展為最小方正範圍儲存格清除內容
        .[A1].Resize(N, 27) = Application.Transpose(Arr) 'Transpose 超過OFFICE版本限制列數會錯誤
        '↑令[A1]擴展向下N列,向右27欄的範圍儲存格值以Arr陣列值轉置後倒入
    End With
    MsgBox Format(Timer - ST, "0.0秒")
    '↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub

Andy2483

用同一個二維陣列處理:
1.先放入原始資料
2.將符合條件的資料從陣列的最前方逐列放入覆蓋掉原始資料
3.最後精確的將結果資料提出放入儲存格中

下載 (38.12 KB)

2023-2-14 09:58

Sub 加法2()
    Dim Arr()
    '↑宣告Arr是還沒宣告維度的陣列
    ST = Timer
    '↑令ST是 現在時間
    With ActiveSheet
    '↑以下是關於現用工作表的程序
        er = .UsedRange.Rows.Count
        '↑令er是數字 使用的儲存格擴展為最小方正範圍的列數
        ReDim Arr(1 To er, 1 To 27)
        '↑宣告Arr是二維陣列,範圍縱向從1到 er變數列,橫向從1到 27欄
        For r = 1 To er
        '↑設順迴圈!r從1 到 er變數
            If Application.WorksheetFunction.CountIf(Range("A" & r & ":AA" & r), "EC1-") = 0 Then
            '↑如果以 WorksheetFunction.CountIf 方法回傳值是 0 ??
            'A欄r變數列儲存格到 AA欄r變數列儲存格,此範圍儲存格值是 "EC1-" 字串的 儲存格數量
                N = N + 1
                '↑令N變數累加 1
                For c = 1 To 27
                '↑設順迴圈!c從1 到 27
                    Arr(N, c) = .Cells(r, c).Value
                    '↑令N列c欄Arr陣列值是 r列c欄儲存格值
                Next c
            End If
        Next r
        .UsedRange.ClearContents
        '↑令使用的儲存格擴展為最小方正範圍儲存格清除內容
        .[A1].Resize(N, 27) = Arr
        '↑令[A1]擴展向下N列,向右27欄的範圍儲存格值以 Arr陣列值倒入
    End With
    MsgBox Format(Timer - ST, "0.0秒")
    '↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub

Andy2483

逆迴圈刪除符合條件的列

Option Base 1
'↑加了 這行 Option Base 1 ,陣列的起始索引號會是 1 (原預設值是 0)
Sub 減法1()
    ST = Timer
    '↑令ST是 現在時間
    Application.ScreenUpdating = False
    '↑令螢幕暫不隨著程序執行作結果的變化
    er = ActiveSheet.UsedRange.Rows.Count
    '↑令er變數是 現表已使用儲存格擴展為最小方正範圍的列數
    'PS:如果已使用儲存格中間有空列/空欄隔成多區!UsedRange將他視為連接的一區
    For i = er To 1 Step -1
    '↑設逆迴圈!i從 er變數到 1,每次迴圈讓i變數 -1
        If Application.CountIf(Rows(i), "EC1-*") > 0 Then Rows(i).Delete
        '↑如果以 WorksheetFunction.CountIf 方法回傳值是 > 0 !就刪除i迴圈列,下方的儲存格會往上遞補
        '方法:A欄r變數列儲存格到 AA欄r變數列儲存格,此範圍儲存格值是 開頭為"EC1-" 字串的 儲存格數量
    Next i
    MsgBox Format(Timer - ST, "0.0秒")
    '↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub


Sub 減法2()
    ST = Timer
    '↑令ST是 現在時間
    Application.ScreenUpdating = False
    '↑令螢幕暫不隨著程序執行作結果的變化
    er = ActiveSheet.UsedRange.Rows.Count
    '↑令er變數是 現表已使用儲存格擴展為最小方正範圍的列數
    'PS:如果已使用儲存格中間有空列/空欄隔成多區!UsedRange將他視為連接的一區
    For i = er To 1 Step -1
    '↑設逆迴圈!i從 er變數到 1,每次迴圈讓i變數 -1
        If Not IsError(Application.Match("EC1-*", Rows(i), 0)) Then Rows(i).Delete
        '如果以Match()方法找迴圈列各儲存格裡 開頭為"EC1-" 字串,而Match()不是傳回#N/A 錯誤值,
        '如果條件成立!就刪除i迴圈列,下方的儲存格會往上遞補
        'PS:如果 Match 找不到相符專案，則會傳回#N/A 錯誤值。
        'https://learn.microsoft.com/zh-tw/office/vba/api/excel.worksheetfunction.match
        'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/iserror-function
    Next i
    MsgBox Format(Timer - ST, "0.0秒")
    '↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub

Andy2483

1.符合刪除條件的列,應用 錯誤值字串 在第1欄植入
2.應用 Range.SpecialCells 方法 ,.Delete (3)刪除整列

Sub DelArray1()
Dim Arr, Brr, x&, Xm&, y&, Ym&, N&
'↑宣告變數:(Arr,Brr)是 通用型變數,其他是長整數變數
ST = Timer
'↑令ST是 現在時間
With ActiveSheet.UsedRange
'↑以下是關於現表已使用儲存格擴展為最小方正範圍儲存格的程序
'PS:如果已使用儲存格中間有空列/空欄隔成多區!UsedRange將他視為連接的一區
     Arr = .Value
     '↑令Arr這通用型變數是二維陣列,以這With程序儲存格值帶入
     Brr = .Columns(1).Value
     '↑令Brr這通用型變數是二維陣列,以這With程序地1欄儲存格值帶入
     Ym = UBound(Arr, 1)
     '↑令Ym這長整數變數是Arr陣列縱向最大索引列號數
     'PS: 1 可以省略
     Xm = UBound(Arr, 2)
     '↑令Xm這長整數變數是Arr陣列橫向最大索引欄號數
     For y = 1 To Ym
     '↑設順迴圈!y從1 到 Ym變數
         For x = 1 To Xm
         '↑設順迴圈!x從1 到 Xm變數
             If InStr(Arr(y, x), "EC1-") Then Brr(y, 1) = "#N/A": Exit For
             '↑如果y迴圈列x迴圈欄Arr陣列值裡包含了 "EC1-"字串!
             '就令y迴圈列第1欄Brr陣列值是 "#N/A" 字串,然後結束此x內迴圈
         Next x
     Next y
     With .Columns(1)
     '↑以下是關於外With程序儲存格第1欄的程序
          .Value = Brr
          '↑令值是 Brr陣列值
          .SpecialCells(xlCellTypeConstants, 16).Delete (3)
         '↑令 有錯誤值的單元格所在的列刪除
          'https://learn-microsoft-com.translate.goog/en-us/office/vba/api/excel.range.specialcells?_x_tr_sl=en&_x_tr_tl=zh-TW&_x_tr_hl=zh-TW&_x_tr_pto=sc
          'https://learn-microsoft-com.translate.goog/en-us/office/vba/api/excel.xlspecialcellsvalue?_x_tr_sl=en&_x_tr_tl=zh-TW&_x_tr_hl=zh-TW&_x_tr_pto=sc
          'https://learn-microsoft-com.translate.goog/en-us/office/vba/api/excel.xlcelltype?_x_tr_sl=en&_x_tr_tl=zh-TW&_x_tr_hl=zh-TW&_x_tr_pto=sc
          '.Delete (3): https://learn.microsoft.com/zh-tw/office/vba/api/excel.worksheet.rows
     End With
End With
MsgBox Format(Timer - ST, "0.0秒")
'↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub

Andy2483

用兩個陣列處裡,一個裝原始資料,一個裝結果資料

Sub DelArray2()
Dim Arr, Brr, x&, Xm&, y&, Ym&, N&
'↑宣告變數:(Arr,Brr)是 通用型變數,其他是長整數變數
ST = Timer
'↑令ST是 現在時間(秒)
With ActiveSheet.UsedRange
'↑以下是關於現表已使用儲存格擴展為最小方正範圍儲存格的程序
'PS:如果已使用儲存格中間有空列/空欄隔成多區!UsedRange將他視為連接的一區
     Arr = .Value
     '↑令Arr這通用型變數是二維陣列,以這With程序儲存格值帶入
     Ym = UBound(Arr, 1)
     '↑令Ym這長整數變數是Arr陣列縱向最大索引列號數
     'PS:可以省略為 Ym = UBound(Arr)
     Xm = UBound(Arr, 2)
     '↑令Xm這長整數變數是Arr陣列橫向最大索引欄號數
     .ClearContents
     '↑令清除儲存格裡的內容
     ReDim Brr(1 To Ym, 1 To Xm)
     '↑宣告Brr這通用型變數是二維陣列,陣列大小:縱向從1到 Ym變數,橫向從1到 Xm變數
     For y = 1 To Ym
     '↑設順迴圈!y從1到 Ym變數
         For x = 1 To Xm
         '↑設順迴圈!x從1到 Xm變數
             If InStr(Arr(y, x), "EC1-") Then GoTo 101
             '↑如果y迴圈列x迴圈欄Arr陣列值裡有包含 "EC1-" 字串!就跳到 101位置繼續執行
         Next x
         N = N + 1
         '↑令N這長整數變數累加 1
         For x = 1 To Xm: Brr(N, x) = Arr(y, x): Next x
         '↑設順迴圈!x從1到 Xm變數: 令N變數列x迴圈欄Arr陣列值是 y迴圈列x迴圈欄Arr陣列值
101: Next y
     .Value = Brr
     '↑令這ActiveSheet.UsedRange以Brr陣列值帶入
     '這ActiveSheet.UsedRange範圍比Brr陣列大!為什麼不會產生錯誤格 #N/A ??
     '經測試初步理解其規則:
     '1.超出原ActiveSheet.UsedRange範圍大小才會 產生錯誤格 #N/A
     '2.如果陣列帶入起始格不是原來位置,不影響其結果,以1.範圍大小決定其是否產生錯誤格 #N/A
End With
MsgBox Format(Timer - ST, "0.0秒")
'↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub

Andy2483

1.利用2個陣列加1輔助欄輔助索引號:
1.1.將符合刪除條件的列在輔助欄顯示空字元
2.2.不符合刪除條件的列在輔助欄顯示累加索引號

2.整個區域做輔助欄順排序,將符合刪除條件的列擠到後面去

3.將符合刪除條件的列一次清除掉

4.將輔助欄清除

下載 (25.12 KB)

2023-2-17 08:49

Sub DelArray3()
Dim Arr, Brr(), xArea As Range, x&, Xm&, y&, Ym&, N&
'↑宣告變數:Arr是 通用型變數,Brr是陣列,xArea是儲存格變數,其他是長整數變數
ST = Timer
'↑令ST是 現在時間(秒)
With ActiveSheet.UsedRange
'↑以下是關於現表已使用儲存格擴展為最小方正範圍儲存格的程序
     Arr = .Value
     '↑令Arr這通用型變數是二維陣列,以這With程序儲存格值帶入
     Ym = UBound(Arr, 1)
     '↑令Ym這長整數變數是Arr陣列縱向最大索引列號數
     'PS:可以省略為 Ym = UBound(Arr)
     Xm = UBound(Arr, 2)
     '↑令Xm這長整數變數是Arr陣列橫向最大索引欄號數
     Set xArea = .Resize(Ym, Xm + 1)
     '↑令xArea這儲存格變數是 以這With程序儲存格擴展向下Ym變數列,
     '向右(Xm變數 + 1)欄
     '(PS:增加1輔助欄)
     ReDim Brr(1 To Ym, 0)
     '↑宣告Brr這陣列變數是二維的,
     '大小:縱向從1到Ym變數列,橫向1欄,索引號是0到0
     For y = 1 To Ym
     '↑設順迴圈!y從1到Ym變數
         For x = 1 To Xm
         '↑設順迴圈!x從1到Xm變數
             If InStr(Arr(y, x), "EC1-") Then GoTo 101
             '↑如果以InStr()判斷回傳值不是0,就跳到 101位置繼續執行
             'PS:判斷:y變數列第x變數欄Arr陣列值裡從第幾個字開始包含 "EC1-"字串
             '如果不包含就回傳 0
         Next x
         N = N + 1: Brr(y, 0) = N
         '↑令N這長整數變數累加 1:令y變數列0索引號欄Brr陣列值是 N變數
101: Next y
     If N = Ym Then Exit Sub
     '↑如果N變數=Ym變數!就結束程式執行(代表沒有符合條件的列)
     xArea.Columns(Xm + 1) = Brr
     '↑令xArea變數的(Xm變數+1)欄範圍儲存格以Brr陣列值帶入(PS:輔助欄帶入輔助索引值)
End With
With xArea
'↑以下是關於 xArea變數的程序
     .Sort Key1:=.Item(Xm + 1), Order1:=xlAscending, Header:=xlNo
     '↑令xArea(儲存格)以(Xm變數+1)欄第1列儲存格所在的欄(AB欄)當基準,
     '做沒有標題列的順排序排序
     .Rows(N + 1 & ":" & Ym).Clear
     '↑令xArea變數範圍裡的第 (N變數 + 1)列到 範圍裡的Ym變數列,
     '這範圍儲存格清除
     .Columns(Xm + 1).Clear
     '↑令xArea變數的(Xm變數+1)欄範圍儲存格清除 (PS:輔助欄清除)
End With
MsgBox Format(Timer - ST, "0.0秒")
'↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub

Andy2483

符合刪除條件的列
1.先用 錯誤值字串取代符合條件的儲存格值
2.再應用 Range.SpecialCells 方法 ,.Delete (3)刪除整列

Option Explicit
Sub 取代法()
Dim ST
    ST = Timer
    '↑令ST是 現在時間(秒)
    With ActiveSheet.UsedRange
    '↑以下是關於現表已使用儲存格擴展為最小方正範圍儲存格的程序
        .Replace "EC1-", "#N/A"
        '↑令儲存格值是 "EC1-"字串的,都將儲存格值置換為"#N/A"
        .SpecialCells(xlCellTypeConstants, 16).Delete (3)
        '↑令 有錯誤值的單元格所在的列刪除
    End With
    MsgBox Format(Timer - ST, "0.0秒")
    '↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub

Andy2483

Option Explicit
Sub 輔助欄公式()
Dim y&, N&, ST
'↑宣告變數:(y,N)是長整數變數,ST是通用型變數
ST = Timer
'↑令ST是 現在時間(秒)
y = ActiveSheet.UsedRange.Rows.Count
'↑令y這長整數變數是 現表已使用儲存格擴展為最小方正範圍的列數
'PS:如果已使用儲存格中間有空列/空欄隔成多區!UsedRange將他視為連接的一區
With [AB3].Resize(y)
'↑以下是關於[AB3]往下擴展y變數列的程序
     .Formula = "=IF(ISNA(MATCH(""EC1-*"",A3:AA3,0)),ROW(),""NA"")"
     '↑令儲存格公式是 如果找不到吻合條件的儲存格數就顯示列數,否則就顯示 "NA"字串
     .Value = .Value
     '↑令範圍儲存格值是 其顯示的公式值
     .Replace "NA", "", Lookat:=xlWhole
     '↑令範圍儲存格值,全吻合"NA"的就置換為空白
End With
[A3:AB3].Resize(y).Sort Key1:=[AB3], Order1:=xlAscending, Header:=xlNo
'↑令[A3:AB3]往下擴展y列的範圍以[AB3]為基準做沒有標題列的順排序
N = [AB3].End(xlDown).Row
'↑令N是[AB3]往下尋空白格的前一列列號
Rows(N + 1 & ":65536").Clear
'↑令N+1列到65536列 清除
[AB:AB].Clear
'↑輔助欄清除
MsgBox Format(Timer - ST, "0.0秒")
'↑跳出提示窗 以小數點1位的格式顯示執行的秒數
End Sub