如何将INDEX查找公式转换为VBA以实现返回真空白单元格

你原有公式返回的""是空文本值，不属于Excel识别的真空白单元格，所以粘贴时SkipBlanks:=True无法跳过这类单元格。以下VBA代码直接实现你原有的数据清洗逻辑，无匹配结果时会返回真空白：

Sub 清洗数据并输出真空白()
    Dim dataArr, resArr()
    Dim sourceLastRow As Long, i As Long, resCount As Long
    
    ' 读取DATA表有效数据范围
    sourceLastRow = Sheets("DATA").Cells(Rows.Count, "D").End(xlUp).Row
    dataArr = Sheets("DATA").Range("C2:D" & sourceLastRow).Value
    
    ' 初始化结果数组
    ReDim resArr(1 To sourceLastRow - 1, 1 To 1)
    resCount = 1
    
    ' 筛选D列不为0的对应C列值
    For i = 1 To UBound(dataArr)
        If dataArr(i, 2) <> 0 Then
            resArr(resCount, 1) = dataArr(i, 1)
            resCount = resCount + 1
        End If
    Next i
    
    ' 清空CALC表W列原有内容并写入结果
    Sheets("CALC").Range("W3:W" & Rows.Count).ClearContents
    Sheets("CALC").Range("W3").Resize(UBound(resArr), 1).Value = resArr
    
    ' 直接完成粘贴到FORM(3)表的操作，空白会被正常跳过
    Sheets("CALC").Range("W3:W" & resCount + 1).Copy
    Sheets("FORM (3)").Range("B20").PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
    Application.CutCopyMode = False
End Sub

代码说明 #

• 用数组处理数据，比工作表公式运算效率更高，适配你4~50条不等的数据量场景
• 无匹配值的位置写入单元格后是真正的空白，SkipBlanks参数可以正常识别
• 全流程自动化，不需要手动选范围复制粘贴

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