1

预先感谢您的帮助和理解 - 目前，我正在迈出 VBA 世界的第一步 :)

每隔几天我就会收到客户名单——我有义务检查他们是否存在于我们的数据库中。我决定基于 Vlookup 函数创建一个简单的宏。这个想法很简单——宏将在第一张表（“数据库”）中的表中搜索客户，并在第二张表（“工具”）中给出输出。两张工作表都放在同一个工作簿中。值得注意的是，查找范围有一些空白单元格，其中没有输入。

但是，当我尝试执行宏时，它会遇到 1004 错误（无法获取 WorksheetFunction 类的 Vlookup 属性）。我已经尝试将 WorksheetFunction.Vlookup 切换到 Application.Vlookup，但不幸的是它根本没有帮助。

在这里处理错误的好方法是什么？

Sub Macro()

Dim rng As Range
Dim FinalResult As Variant
Dim Table_Range As Range
Dim LookupValue As Range

Set rng = Sheets("Tool").Range("B:B") 'I've decided to use the entire column as a range because the number of customers to check is different every time
Set Table_Range = Sheets("Database").Range("C:H")
Set LookupValue = Sheets("Tool").Range("A:A") 
FinalResult = Application.WorksheetFunction.VLookup(LookupValue, Table_Range, 6, 0)
rng = FinalResult

End Sub
4

1 回答 1

0

VBA 查找 ( For Each...Next, Application.Match)

  • 调整常量部分中的值。
Option Explicit

Sub CustomersLookup()
    
    ' Source
    Const sName As String = "Database" ' Worksheet Name
    Const sfRow As Long = 2 ' First Data Row
    Const slCol As String = "C" ' Lookup Column
    Const svCol As String = "H" ' Value Column
    
    ' Destination
    Const dName As String = "Tool" ' Worksheet Name
    Const dfRow As Long = 2 ' First Data Row
    Const dlCol As String = "A" ' Lookup Column
    Const dvCol As String = "B" ' Value Column
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, slCol).End(xlUp).Row
    If slRow < sfRow Then Exit Sub
    Dim slrg As Range ' Source Lookup Range (Lookup Range)
    Set slrg = sws.Range(sws.Cells(sfRow, slCol), sws.Cells(slRow, slCol))
    Dim svrg As Range ' Source Value Range
    Set svrg = slrg.EntireRow.Columns(svCol)
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dlCol).End(xlUp).Row
    If dlRow < dfRow Then Exit Sub
    Dim dlrg As Range ' Destination Lookup Range
    Set dlrg = dws.Range(dws.Cells(dfRow, dlCol), dws.Cells(dlRow, dlCol))
    ' Destination Value Range is handled per cell, using 'EntireRow'.
    
    Application.ScreenUpdating = False
    
    ' Loop and write.
    Dim dlCell As Range ' Destination Lookup Cell (Lookup Value)
    Dim dvCell As Range ' Destination Value Cell (Result)
    Dim srIndex As Variant ' Source Row Index (Row of the Match)
    Dim dString As String ' Lookup Value Converted to a String
    For Each dlCell In dlrg.Cells
        If Not IsError(dlCell) Then ' check if error value
            dString = CStr(dlCell.Value)
            If Len(dString) > 0 Then ' check if blank
                Set dvCell = dlCell.EntireRow.Columns(dvCol)
                ' Attempt to find a match.
                srIndex = Application.Match(dString, slrg, 0)
                If IsNumeric(srIndex) Then ' match found
                    dvCell.Value = svrg.Cells(srIndex).Value
                Else ' match not found
                    dvCell.Value = "Nope" ' or whatever
                End If
            End If
        End If
    Next dlCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Operation finished successfully.", vbInformation, "Customers Lookup"
    
End Sub
于 2021-08-24T00:47:17.867 回答