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

　暱稱: 厚臉皮的學生

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

2^#

發表於 2023-2-14 09:58 | 只看該作者

本帖最後由 Andy2483 於 2023-2-14 10:09 編輯

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

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

3^#

發表於 2023-2-15 08:48 | 只看該作者

本帖最後由 Andy2483 於 2023-2-15 08:49 編輯

逆迴圈刪除符合條件的列

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

4^#

發表於 2023-2-15 09:40 | 只看該作者

本帖最後由 Andy2483 於 2023-2-15 09:42 編輯

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

5^#

發表於 2023-2-15 16:45 | 只看該作者

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

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

6^#

發表於 2023-2-17 08:52 | 只看該作者

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

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

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

4.將輔助欄清除

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

7^#

發表於 2023-2-17 16:08 | 只看該作者

本帖最後由 Andy2483 於 2023-2-17 16:09 編輯

符合刪除條件的列
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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1425
主題: 40
精華: 0
積分: 1449
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-4-16

8^#

發表於 2023-2-20 16:27 | 只看該作者

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流