自动过滤数据的 VLOOKUP 宏

Question

我仍在学习 VBA，想知道是否有办法在过滤范围内运行 VLOOKUP。

比如下面的代码，我过滤数据后，第一行有数据的是A4。

但是，我必须手动指定第一行数据在 A4 中。

我的问题是是否有可能让宏自己检测第一行数据，而不是我必须指定。

我读过关于可能使用 SpecialCells 的文章。

我正在尝试这样做，因为我收到的数据集每天都在变化，所以今天第一个过滤的行是 A4 可能是 A15 或明天的任何内容。

谢谢

Range("A4").Select '/这里必须指定范围

Dim 公式为字符串

formul = "=VLOOKUP(C2,Sheet2!A:B,2,0)"

Range("A4:A" & Cells(Rows.Count, 1).End(xlUp).Row) = [formul] '/这里也指定范围

'''

编辑：带有 SpecialCells 的代码： ''' vba

Range("A1").Select '/have to specify range here

Dim formul As String

formul = "=VLOOKUP(C1,Sheet2!A:B,2,0)"

Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible) = [formul] '/also specify range here

'''

Answer 1

过滤单元格的公式

• 这将过滤列C 并将公式写入列A 中的过滤单元格。

Option Explicit

Sub FormulaToFilteredCells()
    
    Const sName As String = "Sheet2"
    Const dName As String = "Sheet1"
    Const dLookupColumn As Long = 1
    Const dCriteriaColumn As Long = 3
    Const dCriteria As String = "Yes"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    If dws.FilterMode Then dws.ShowAllData ' remove previous filter
    
    Dim drg As Range ' Destination Table Range (has headers)
    Set drg = dws.Range("A1").CurrentRegion.Columns(dCriteriaColumn)
    Dim ddrg As Range ' Destination Data Range (no headers)
    Set ddrg = drg.Resize(drg.Rows.Count - 1).Offset(1)
    Dim dcOffset As Long: dcOffset = dLookupColumn - dCriteriaColumn
    
    drg.AutoFilter 1, dCriteria
    
    Dim dvdrg As Range ' Destination Visible Data Range
    On Error Resume Next
        Set dvdrg = ddrg.SpecialCells(xlCellTypeVisible).Offset(, dcOffset)
    On Error GoTo 0
    
    dws.AutoFilterMode = False
    
    If dvdrg Is Nothing Then Exit Sub ' no filtered cells
    
    dvdrg.Formula = "=VLOOKUP(" & dvdrg.Cells(1).Offset(, -dcOffset) _
        .Address(0, 0) & ",'" & dName & "'!A:B,2,0)"
    
End Sub

Answer 2

可以使用here、here 和here 所示的数组公式处理过滤后的数据。

• 为什么不将过滤后的数据复制到新的工作表中？
• 并在第二个工作表中对过滤后的数据使用 vlookup？

样本数据：Wikipedia => List_of_countries_by_population

Sub FilterTable_and_Copy()

    'Prepare Sheet2
    If Sheets(2).Name <> "Filtered Data" Then
        Sheets.Add After:=Sheets(1)
        Sheets(2).Name = "Filtered Data"
    End If
    Sheets(2).Columns("A:G").ClearContents
    
    'The Data is prepared in the Table "myTable"
    'ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$F$100"), , _
    '   xlYes).Name = "myTable"
    
    'Filter Data
    Sheets(1).Select
    ActiveSheet.Range("myTable").AutoFilter Field:=2, Criteria1:="Asia"
    
    'Copy Filtered Data to Sheet2
    Range("myTable").Copy
    Sheets(2).Select
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    'Copy Header
    Sheets(1).Select
    Rows("1:1").Copy
    Sheets(2).Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    'Format Columns Width
    Columns("A:F").ColumnWidth = 30
    Columns("A:F").EntireColumn.AutoFit
    Range("G1").Select

    'Create Table "Table_FilteredData"
    Sheets(2).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , _
        xlYes).Name = "Table_FilteredData"
    
    'Correct Formatting Issue
    Dim myRange As Range
    With Sheets(2).ListObjects("Table_FilteredData")
        Set myRange = .Range
        .Unlist
    End With
    
    With myRange
        .Interior.ColorIndex = xlColorIndexNone
        .Font.ColorIndex = xlColorIndexAutomatic
        .Borders.LineStyle = xlLineStyleNone
    End With
    
    Sheets(2).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , _
        xlYes).Name = "Table_FilteredData"
    Sheets(2).ListObjects(1).TableStyle = "TableStyleMedium3"
    
End Sub

为“region = Asia”过滤的数据：