使用VBA中XLOOKUP函数填充Excel表格空白值的技术求助

填充规则 #

• 空白单元格优先取同国家+Yellow+同年份对应的值
• 若上述值为空，取对应区域+同颜色+同年份对应的值
• 若仍为空，取对应区域+Yellow+同年份对应的值

原代码问题分析 #

你提供的VBA代码存在以下问题：

1. LCol 获取逻辑错误：原代码取WS.Cells(LRow, 29)的值，未正确定位年份列的最后一列
2. 变量声明不规范：仅search3声明为Range类型，其余变量默认变体类型，易引发类型错误
3. XLookup拼接逻辑错误：查找键与查找区域的维度拼接不匹配，无法准确定位目标结果
4. 未处理无匹配场景：使用WorksheetFunction.XLookup会在无匹配时抛出运行时错误

修正后的完整代码 #

Sub FillBlankCells()
    Dim WB As Workbook
    Dim WS As Worksheet
    Set WB = ActiveWorkbook
    Set WS = WB.Sheets("BASIS")
    
    Dim LRow As Long, LCol As Long, r As Long, c As Long
    Dim country As String, region As String, currentColor As String, targetYear As String
    Dim lookupResult As Variant
    
    Application.ScreenUpdating = False
    
    ' 获取有效数据行数（以B列为基准）
    LRow = WS.Range("B" & WS.Rows.Count).End(xlUp).Row
    ' 获取年份列的最后一列（从第2行向右查找）
    LCol = WS.Cells(2, WS.Columns.Count).End(xlToLeft).Column
    
    For c = 8 To LCol
        targetYear = WS.Cells(2, c).Value
        For r = 3 To LRow - 1 ' 跳过合计行
            currentColor = WS.Cells(r, 5).Value ' E列为颜色列
            country = WS.Cells(r, 4).Value ' D列为国家列
            region = WS.Cells(r, 3).Value ' C列为区域列
            
            If WS.Cells(r, c).Value = "" Then
                ' 第一优先级：同国家+Yellow+同年份
                lookupResult = Application.XLookup(country & "Yellow" & targetYear, _
                    WS.Range("D3:D" & LRow) & WS.Range("E3:E" & LRow) & WS.Range("H2:AC2"), _
                    WS.Range("H3:AC" & LRow), , 0)
                
                ' 第二优先级：对应区域+同颜色+同年份
                If IsError(lookupResult) Then
                    lookupResult = Application.XLookup(region & currentColor & targetYear, _
                        WS.Range("C3:C" & LRow) & WS.Range("E3:E" & LRow) & WS.Range("H2:AC2"), _
                        WS.Range("H3:AC" & LRow), , 0)
                    
                    ' 第三优先级：对应区域+Yellow+同年份
                    If IsError(lookupResult) Then
                        lookupResult = Application.XLookup(region & "Yellow" & targetYear, _
                            WS.Range("C3:C" & LRow) & WS.Range("E3:E" & LRow) & WS.Range("H2:AC2"), _
                            WS.Range("H3:AC" & LRow), "", 0)
                    End If
                End If
                
                ' 填充结果（无匹配则保持空）
                If Not IsError(lookupResult) Then
                    WS.Cells(r, c).Value = lookupResult
                End If
            End If
        Next r
    Next c
    
    Application.ScreenUpdating = True
End Sub

关键修正说明 #

• 调整行列边界的获取逻辑，确保遍历范围准确覆盖有效数据
• 规范变量类型与命名，提升代码可读性与可维护性
• 使用Application.XLookup替代WorksheetFunction.XLookup，避免无匹配时触发运行时错误
• 按规则依次降级查找，完整实现三层填充逻辑

内容的提问来源于stack exchange，提问作者Elisa R.