如果過濾后的資料為空或找不到資料，如何不復制？

我是VBA的初學者。如果條件或過濾表為空然后繼續其他條件，我該如何忽略？

這是我目前使用的代碼：

   Sub Macro7()
    '
    ' Macro7 Macro
    '
     Dim LastRow As Long
    '
    Sheets("Ref2").Select
    ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=3, Criteria1:=Sheets("NOV 2022").Range("E1").Value
   ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A6").Value
   LastRow = Range("E" & Rows.Count).End(xlUp).Row
   Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
   Selection.copy
   Sheets("NOV 2022").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   ActiveWindow.SmallScroll Down:=21
   Sheets("Ref2").Select
   ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A37").Value
   LastRow = Range("E" & Rows.Count).End(xlUp).Row
   Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
   Selection.copy
   Sheets("NOV 2022").Select
   Range("C37").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   ActiveWindow.SmallScroll Down:=21
   Range("C58").Select
   Sheets("Ref2").Select
   ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A58").Value
    LastRow = Range("E" & Rows.Count).End(xlUp).Row
    Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
   Selection.copy
   Sheets("NOV 2022").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   ActiveWindow.SmallScroll Down:=27
   Range("C93").Select
   Sheets("Ref2").Select
   ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A93").Value
   LastRow = Range("E" & Rows.Count).End(xlUp).Row
   Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
   Selection.copy
   Sheets("NOV 2022").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  End Sub

uj5u.com熱心網友回復：

復制過濾后的資料（翻譯宏記錄器代碼）

Option Explicit

Sub UpdateNov2022()
    
    Dim CriteriaAddresses() As Variant:
    CriteriaAddresses = VBA.Array("E1", "A6", "A37", "A58", "A93")
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Ref2")
    If sws.FilterMode Then sws.ShowAllData
    
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' Table Range
    
    Dim scrg As Range ' Copy Range (no headers)
    With srg
        Set scrg = srg.Columns("E:O").Resize(.Rows.Count - 1).Offset(1)
    End With
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("NOV 2022")
    
    Dim dcCell As Range ' Criteria Cell
    Dim CriteriaString As String
    
    Set dcCell = dws.Range(CriteriaAddresses(0))
    CriteriaString = CStr(dcCell.Value)
    srg.AutoFilter Field:=3, Criteria1:=CriteriaString
    
    Dim svrg As Range ' Visible Range (no headers)
    Dim dpCell As Range ' Paste Cell
    Dim n As Long
    
    For n = 1 To UBound(CriteriaAddresses)
        Set dcCell = dws.Range(CriteriaAddresses(n))
        CriteriaString = CStr(dcCell.Value)
        srg.AutoFilter Field:=4, Criteria1:=CriteriaString
        On Error Resume Next
            Set svrg = scrg.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not svrg Is Nothing Then
            svrg.Copy
            Set dpCell = dws.Cells(dcCell.Row, "C")
            dpCell.PasteSpecial Paste:=xlPasteValues
            Set svrg = Nothing
        End If
    Next n
      
    Application.CutCopyMode = False
    sws.ShowAllData ' or to remove: sws.AutoFilterMode = False 
  
End Sub

標籤：擅长vba

上一篇：使用Python回圈遍歷Pandas資料框或Excel表

下一篇：檢查Excel是否為空