excel - 如何使用 vba 和另一个工作簿仅对空单元格应用 vlookup

Question

我想通过 VBA 仅在空白单元格上应用 vlookup。我正在使用下面的代码，但它给了我一个运行时错误 13“类型不匹配”。当我通过 F8 逐步运行代码时，我还在位置 处收到错误 2042如果 i = ""那么 ，这也表示“#N/A”。

Dim FileName3 As String

FileName3 = "C:xxxxxx.xlsx"

Dim wb As Workbook: Set wb = ThisWorkbook
Dim lastrow As Long
Dim ws As Worksheet: Set ws = wb.Sheets("Data")
lastrow = ws.cells(Rows.Count, 1).End(xlUp).Row
Dim wb2 As Workbook: Set wb2 = Workbooks.Open(Filename:=FileName3, ReadOnly:=True)
Dim rng As Range: Set rng = ThisWorkbook.Worksheets("Data").Range("S2" & lastrow)
Dim lookupRange As Range: Set lookupRange = wb2.Sheets("Page 1").Range("B2" & lastrow)
Dim i As Range

For Each i In rng
If i = "" Then
i = Application.VLookup(ThisWorkbook.Sheets("Data").Range("A" & i.Row), lookupRange, 2, False)

'MsgBox c.Row
End If
'
Next i
'/////// paste by value

Sheets("Data").Columns(52).Copy
Sheets("Data ").Columns(52).PasteSpecialxlPasteValues
wb2.Close False

ThisWorkbook.Save

我之前用 WorksheetFunction.VlookUp 尝试过，但出现了同样的错误。
对于所有空单元格，应在“S”列的数据表(“数据”)中执行 VlookUp。
查找值位于另一个工作簿文件中。如果有人可以帮助我，我将不胜感激。

Answer 1

空白单元格的 VBA VLookup

Option Explicit

Sub VLookupBlanks()

    Const sFilePath As String = "C:\xxxxxx.xlsx"

    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Set swb = Workbooks.Open(Filename:=sFilePath, ReadOnly:=True)
    Dim sws As Worksheet: Set sws = swb.Worksheets("Page 1")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "B").End(xlUp).Row
    Dim srg As Range: Set srg = sws.Range("B2:C" & slRow)

    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets("Data")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "A").End(xlUp).Row
    Dim drg As Range: Set drg = dws.Range("S2:S" & dlRow)
    
    Dim dCell As Range
    Dim dValue As Variant
    
    For Each dCell In drg.Cells
        If Len(CStr(dCell.Value)) = 0 Then
            dValue = Application.VLookup( _
                dCell.EntireRow.Columns("A").Value, srg, 2, False)
            If Not IsError(dValue) Then dCell.Value = dValue
        End If
    Next dCell
 
    swb.Close SaveChanges:=False
    
    With drg.EntireRow.Columns("AZ")
        .Value = .Value
    End With
    
    dwb.Save

    Application.ScreenUpdating = True

    MsgBox "Columns updated.", vbInformation

End Sub