Excel VBA双条件比对两个工作表并填充Sheet1空单元格

解决方案 #

该需求完全可以实现，提供两种可选方案：

方案1：公式方案（无需写代码，适合非VBA用户） #

因为两张表结构完全一致，不需要额外做双条件匹配，直接取Sheet2同位置单元格值即可。在Sheet1的C3单元格输入以下公式，下拉右拉填充整个目标区域就行：

=IF(ISBLANK(Sheet1!C3), Sheet2!C3, Sheet1!C3)

如果后续可能出现两张表行/列顺序不一致的情况，确实需要按姓名+日期双条件匹配的话，可以用XLOOKUP实现：

=IF(ISBLANK(C3), XLOOKUP($A3&C$1, Sheet2!$A:$A&Sheet2!$1:$1, Sheet2!C:C), C3)

注意：旧版Excel没有XLOOKUP的话，可以用INDEX+MATCH数组公式替代：

=IF(ISBLANK(C3), INDEX(Sheet2!C:C, MATCH($A3&C$1, Sheet2!$A:$A&Sheet2!$1:$1, 0)), C3)

旧版Excel输入数组公式需要按Ctrl+Shift+Enter确认生效。

方案2：优化后的VBA方案（适合批量自动化处理） #

你原本的遍历思路是可行的，优化后直接读取Sheet2对应位置值即可，不需要调用VLOOKUP函数，运行效率更高：

Sub Fill_empty_cell()
    Dim MR As Range, cell As Range
    ' 限定操作范围为Sheet1的C3:X600区域
    Set MR = Sheet1.Range("C3:X600")
    ' 关闭屏幕更新大幅提升运行速度
    Application.ScreenUpdating = False
    For Each cell In MR
        If IsEmpty(cell.Value) Then
            ' 直接读取Sheet2同位置单元格的值
            cell.Value = Sheet2.Range(cell.Address).Value
        End If
    Next
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

如果需要严格按姓名+日期匹配，就算两张表行/列顺序变动也能正确赋值，可以用以下版本代码：

Sub Fill_empty_cell_WithMatch()
    Dim MR As Range, cell As Range
    Dim nameRow As Long, dateCol As Long
    Set MR = Sheet1.Range("C3:X600")
    Application.ScreenUpdating = False
    For Each cell In MR
        If IsEmpty(cell.Value) Then
            ' 匹配Sheet2中对应姓名的行号
            nameRow = Application.Match(Sheet1.Cells(cell.Row, "A"), Sheet2.Range("A:A"), 0)
            ' 匹配Sheet2中对应日期的列号
            dateCol = Application.Match(Sheet1.Cells(1, cell.Column), Sheet2.Range("1:1"), 0)
            ' 匹配成功才赋值，避免匹配错误返回报错值
            If Not IsError(nameRow) And Not IsError(dateCol) Then
                cell.Value = Sheet2.Cells(nameRow, dateCol).Value
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

内容的提问来源于stack exchange，提问作者Dan Do