在 Excel 工作表中，如何使用動態數組列表（VBA 模塊）消除或刪除、過濾和復制在另一個工作表中定義的選定記錄

Question

我需要專家的幫助，因為我是這方面的新手。 我正在嘗試為 Excel 工作表 (VBA) 創建動態數組宏。 其中我想使用動態數組列表消除（刪除或隱藏）基於主表“ StatusReport ”中特定列（“AlertCount”）中選擇的數據的記錄數。 示例：狀態報告（工作表）

Filter_Criteria （工作表）

預期輸出：

所有記錄應顯示沒有“1055”和“1056”相關的警報計數（消除記錄）

但它現在刪除了所有記錄而不是選定的值

我的模塊如下所示，它僅顯示過濾器記錄，但我需要消除選定的過濾器記錄。 VBA模塊如下：

   Sub DeleteFilter_Data()
Set Data_sh = ThisWorkbook.Sheets("StatusReport")
Set Filter_Criteria = ThisWorkbook.Sheets("Filter_Criteria")
  
Data_sh.AutoFilterMode = False

Dim AlertCount_List() As String
Dim n As Integer

n = Application.WorksheetFunction.CountA(Filter_Criteria.Range("A:A")) - 1
ReDim AlertCount_List(n) As String
Dim i As Integer

For i = 0 To n
        AlertCount_List(i) = Filter_Criteria.Range("A" & i + 2)
Next i

Dim Arr01 As Variant
Dim i01 As Integer
Dim i02 As Integer

'Creates a list of everything in Column I, minus everything in Filter_Criteria list
Arr01 = Range("I2", Range("I2").End(xlDown))
For i01 = 1 To UBound(Arr01, 2)
    For i02 = 0 To n - 1
    If Arr01(i01, 1) = AlertCount_List(i02) Then
        Arr01(i01, 1) = ""
    End If
    Next i02
Next i01

'Turns list into strings (needed for the Filter command).
Dim ListEdited() As String
ReDim ListEdited(1 To UBound(Arr01, 1)) As String
For i01 = 1 To UBound(Arr01, 2)
    ListEdited(i01) = Arr01(i01, 1)
Next i01

'Filter command that keeps all entries except any found within the Filter_Criteria Sheet.

 Data_sh.UsedRange.AutoFilter 9, ListEdited(), xlFilterValues
 
End Sub

請幫助我使用動態數組列表修正宏。

謝謝

鋼架

Answer 1

我認為您要求保留除 Filter_Criteria 表上的那些以外的所有 Alert_Counts？ 下面的代碼就是這樣做的。 如果我誤解了您的問題，請告訴我，我會再試一次。

編輯 20210630：我更新了以下代碼。

Sub HideFilter_Data()
Set Data_sh = ThisWorkbook.Sheets("StatusReport")
Set Filter_Criteria = ThisWorkbook.Sheets("Filter_Criteria")
  
Data_sh.AutoFilterMode = False

Dim AlertCount_List() As String
Dim n As Integer

n = Application.WorksheetFunction.CountA(Filter_Criteria.Range("I:I")) - 1
ReDim AlertCount_List(n) As String
Dim i As Integer

For i = 0 To n
        AlertCount_List(i) = Filter_Criteria.Range("I" & i + 2)
Next i

Dim Arr01 As Variant
Dim i01 As Integer
Dim i02 As Integer

'Creates a list of everything in Column I, minus everything in Filter_Criteria list
Arr01 = Range("I2", Range("I2").End(xlDown))
For i01 = 1 To UBound(Arr01, 1)
    For i02 = 0 To n - 1
    If Arr01(i01, 1) = AlertCount_List(i02) Then
        Arr01(i01, 1) = ""
    End If
    Next i02
Next i01

'Turns list into strings (needed for the Filter command).
Dim ListEdited() As String
ReDim ListEdited(1 To UBound(Arr01, 1)) As String
For i01 = 1 To UBound(Arr01, 1)
    ListEdited(i01) = Arr01(i01, 1)
Next i01

'Filter command that keeps all entries except any found within the Filter_Criteria Sheet.
Data_sh.UsedRange.AutoFilter 9, ListEdited(), xlFilterValues

'Data_sh.UsedRange.AutoFilter 9, AlertCount_List(), xlFilterValues
'Data_sh.UsedRange.AutoFilter 9, Criteria1:="<> 1056"   ‘ This work fine but it's a  hard coded value

End Sub

Answer 2

請嘗試下一個代碼。 正如我在評論中所說的（兩次），不可能過濾兩個以上的“不等於”類型條件。 因此，它解決了您在問題中提出的問題（兩個條件）：

Sub filterCriteriaArray()
  Dim Data_sh As Worksheet, Filter_Criteria As Worksheet, lastR As Long, arrC()
  
  Set Data_sh = ThisWorkbook.Sheets("StatusReport")
  Set Filter_Criteria = ThisWorkbook.Sheets("Filter_Criteria")
  lastR = Filter_Criteria.Range("A" & Filter_Criteria.rows.count).End(xlUp).row
  arrC = Filter_Criteria.Range("A2:A" & lastR).value
 
  Data_sh.UsedRange.AutoFilter field:=9, Criteria1:="<>" & arrC(1, 1), Operator:=xlAnd, Criteria2:="<>" & arrC(2, 1)
End Sub

編輯：

下一個代碼版本使用AdvancedFilter ，它允許使用更多您需要的類型的條件，但它不使用數組作為條件。 我使用了一個技巧，根據從標准表中提取的數組，在新添加的表（隱藏）中創建一個范圍：

Sub filterCriteriaFromArray()
   Dim Data_sh As Worksheet, Filter_Criteria As Worksheet, crit As Worksheet, lastR As Long, arrCr()
   Dim strHeader As String, filtRng As Range, rngCrit As Range, i As Long
   
   strHeader = "Head8" ' "AlertCount"    'important the be the correct header (of I:I column)
   Set Data_sh = ActiveSheet 'ThisWorkbook.Sheets("StatusReport")

   Set filtRng = Data_sh.Range(Data_sh.Range("A1"), _
         Data_sh.cells(Data_sh.UsedRange.rows.count, Data_sh.cells(1, Data_sh.Columns.count).End(xlToLeft).Column))
   Set Filter_Criteria = Data_sh.Next 'ThisWorkbook.Sheets("Filter_Criteria")
   
   lastR = Filter_Criteria.Range("A" & Filter_Criteria.rows.count).End(xlUp).row 'last row in Filter_Criteria
   arrCr = Filter_Criteria.Range("A2:A" & lastR).value                                  'put criteria values in the array
   On Error Resume Next
    Set crit = Sheets("CriteriaSh") 'check if sheets "CriteriaSh" exists
   If err.Number <> 0 Then
        err.Clear                   'if it does not exist, it is created
        Set crit = Data_sh.Parent.Sheets.Add(After:=Worksheets(Sheets.count))
        crit.Name = "CriteriaSh"
        crit.Visible = xlSheetVeryHidden
    Else
        crit.cells.ClearContents    'if it exists its cells are cleared
    End If
   On Error GoTo 0
    For i = 1 To UBound(arrCr) 'Build the range to be used in AdvancedFilter criteria
        crit.cells(1, i).value = strHeader
        crit.cells(2, i).value = "<>" & arrCr(i, 1)
    Next i
    'set the criteria range:
    Set rngCrit = crit.Range(crit.Range("A1"), crit.cells(2, UBound(arrCr)))
    filtRng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rngCrit, Unique:=False
End Sub

Answer 3

我已經得到了如何過濾、消除或隱藏所選記錄並將其復制到另一個工作表的解決方案。 在另一個工作表中定義的過濾器數據列表，並通過工作表上的按鈕按下事件執行模塊。

對於消除數據案例，我們需要從主工作表創建 2 個列表，另一個用於消除記錄工作表。 並比較兩個列表並將匹配的大小寫在主表中替換為空或空白

Sub HideFilter_Data()
Set Data_sh = ThisWorkbook.Sheets("StatusReport")
Set Filter_Criteria = ThisWorkbook.Sheets("Filter_Criteria")
  
Data_sh.AutoFilterMode = False

Dim AlertCount_List() As String
Dim n As Integer

n = Application.WorksheetFunction.CountA(Filter_Criteria.Range("A:A")) - 1
ReDim AlertCount_List(n) As String
Dim i As Integer

For i = 0 To n
        AlertCount_List(i) = Filter_Criteria.Range("A" & i + 2)
Next i

' Create the List of main worksheet
Dim Arr01 As Variant
Dim i01 As Integer
Dim i02 As Integer

Dim r As Integer
Dim r1 As Integer
r = Application.WorksheetFunction.CountA(Data_sh.Range("I:I")) - 2
ReDim StatusCount_List(r + 1) As String

For r1 = 0 To r
        StatusCount_List(r1) = Data_sh.Range("I" & r1 + 2)
Next r1


'Creates a list of everything in Column I, minus everything in Filter_Criteria list
Dim str As Variant
Dim cnt As Integer
cnt = 0

' Executing the double loop for comparing both the List and eleminate the match data from the main sheet.
For Each Item In StatusCount_List
 For Each subItem In AlertCount_List
     If Item = subItem Then
          StatusCount_List(cnt) = ""
         End If
 Next subItem
 cnt = cnt + 1
Next Item

 Data_sh.UsedRange.AutoFilter 9, StatusCount_List(), xlFilterValues

End Sub

主要工作表：

消除標准（隱藏記錄）

輸出（消除/隱藏/刪除）如下：

過濾選定的記錄。 在另一個工作表中定義的過濾器列表。

如果我們需要使用動態數組從另一個工作表的列表中選擇選定的記錄。

Option Explicit ' Force explicit variable declaration.

Sub Filter_Data()
Dim Data_sh As Worksheet
Dim Filter_Criteria As Worksheet
Dim Output_Sh As Worksheet


Set Data_sh = ThisWorkbook.Sheets("StatusReport")
Set Filter_Criteria = ThisWorkbook.Sheets("Filter_Criteria")
Set Output_Sh = ThisWorkbook.Sheets("Output")

Output_Sh.UsedRange.Clear
Data_sh.AutoFilterMode = False

Dim AlertCount_List() As String
Dim n As Integer

n = Application.WorksheetFunction.CountA(Filter_Criteria.Range("A:A")) - 1
ReDim AlertCount_List(n) As String
Dim i As Integer

For i = 0 To n
        AlertCount_List(i) = Filter_Criteria.Range("A" & i + 2)
Next i

  Data_sh.UsedRange.AutoFilter 9, AlertCount_List(), xlFilterValues

End Sub

輸出 ：

將所選記錄復制到新工作表。 在另一個工作表中定義的過濾器列表。

Option Explicit ' 強制顯式變量聲明。

Sub CopyFilter_Data()
Dim Data_sh As Worksheet
Dim Filter_Criteria As Worksheet
Dim Output_Sh As Worksheet


Set Data_sh = ThisWorkbook.Sheets("StatusReport")
Set Filter_Criteria = ThisWorkbook.Sheets("Filter_Criteria")
Set Output_Sh = ThisWorkbook.Sheets("Output")

Output_Sh.UsedRange.Clear
Data_sh.AutoFilterMode = False

Dim AlertCount_List() As String
Dim n As Integer

n = Application.WorksheetFunction.CountA(Filter_Criteria.Range("A:A")) - 1
ReDim AlertCount_List(n) As String
Dim i As Integer

For i = 0 To n
        AlertCount_List(i) = Filter_Criteria.Range("A" & i + 2)
Next i
    

'Data_sh.UsedRange.AutoFilter 9, Array("1055", "1056"), xlFilterValues
Data_sh.UsedRange.AutoFilter 9, AlertCount_List(), xlFilterValues

Data_sh.UsedRange.Copy Output_Sh.Range("A1")
Data_sh.AutoFilterMode = False

'MsgBox ("Data has been copied")

End Sub

輸出 ：