Excel VBA数据提取需求：新增空白列置零逻辑并返回值（代码失效）

背景与需求 #

现有B12单元格使用以下公式可正常运行，其中B1是选择工作表名称的下拉框：

=LET(nn,LET(sortedData,SORTBY(INDIRECT(B1&"!A5:R10998"),
  MATCH(INDIRECT(B1&"!J5:J10998"),Master!C2:C10,0),1,
  MATCH(INDIRECT(B1&"!A5:A10998"),Master!B1:B13,0),1),
  FILTER(sortedData,INDEX(sortedData,0,9)="ABC ROSE",""),IF(nn=0,"",nn))

需新增逻辑：

• 若当前工作表（CS）的M12及以下、S12及以下区域全部空白，则B12赋值为0；
• 否则按上述公式计算结果，且B12最终存储计算值而非公式。

尝试了以下VBA代码但未得到预期结果：

Sub ApplyFormula()
    
    Dim ws As Worksheet
    Dim formula As String
    
    ' Set the worksheet to "CS"
    Set ws = ThisWorkbook.Worksheets("CS")
    
    ' Check if columns M12 and S12 and below are blank
    If Application.WorksheetFunction.CountA(ws.Range("M12:M" & ws.Cells(Rows.Count, "M").End(xlUp).Row)) = 0 And _
       Application.WorksheetFunction.CountA(ws.Range("S12:S" & ws.Cells(Rows.Count, "S").End(xlUp).Row)) = 0 Then
        
        ' Insert zero in B12
        ws.Range("B12").Value = 0
    Else
        ' Apply the formula in B12
        formula="=LET(nn,LET(sortedData,SORTBY(INDIRECT(B1&""!A5:R10998""),MATCH(INDIRECT(B1&""!J5:J10998""),Master!C2:C10,0),1,MATCH(INDIRECT(B1&""!A5:A10998""),Master!B1:B13,0),1),FILTER(sortedData,INDEX(sortedData,0,9)=""ABC ROSE""),""""),IF(nn=0,""""),nn))"
        ws.Range("B12").Formula = formula
    End If
End Sub

问题分析 #

1. 空白区域判断逻辑错误：当M列从M12开始全为空时，ws.Cells(Rows.Count, "M").End(xlUp).Row会返回11，导致Range("M12:M11")是无效区域，CountA函数会触发错误，无法正确判断空白状态。
2. 公式字符串转义错误：原代码中的公式字符串存在括号不匹配和引号转义错误，比如IF(nn=0,""""),nn))多了闭合括号，与原正确公式结构不符。
3. 未将公式转为计算值：原代码仅写入公式，未将计算结果替换为单元格的值，导致B12保留公式而非最终计算值。

修正后的VBA代码 #

Sub ApplyFormula()
    Dim ws As Worksheet
    Dim formula As String
    Dim lastRowM As Long, lastRowS As Long
    Dim rangeM As Range, rangeS As Range
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("CS")
    
    ' 获取M列和S列的最后一行（从第12行开始判断）
    lastRowM = ws.Cells(ws.Rows.Count, "M").End(xlUp).Row
    lastRowS = ws.Cells(ws.Rows.Count, "S").End(xlUp).Row
    
    ' 定义要检查的区域：如果最后一行小于12，说明12及以下全空；否则取到最后一行
    Set rangeM = IIf(lastRowM < 12, ws.Range("M12"), ws.Range("M12:M" & lastRowM))
    Set rangeS = IIf(lastRowS < 12, ws.Range("S12"), ws.Range("S12:S" & lastRowS))
    
    ' 判断两个区域是否全为空
    If Application.WorksheetFunction.CountA(rangeM) = 0 And _
       Application.WorksheetFunction.CountA(rangeS) = 0 Then
        ' 赋值为0
        ws.Range("B12").Value = 0
    Else
        ' 构造正确的公式字符串（修正转义和括号问题）
        formula = "=LET(nn,LET(sortedData,SORTBY(INDIRECT(B1&""!A5:R10998""),MATCH(INDIRECT(B1&""!J5:J10998""),Master!C2:C10,0),1,MATCH(INDIRECT(B1&""!A5:A10998""),Master!B1:B13,0),1),FILTER(sortedData,INDEX(sortedData,0,9)=""ABC ROSE"","""")),IF(nn=0,"""",nn))"
        ' 写入公式并计算
        ws.Range("B12").Formula = formula
        ' 将公式结果转为值
        ws.Range("B12").Value = ws.Range("B12").Value
    End If
End Sub

修正说明 #

• 修正了空白区域的判断逻辑：当最后一行小于12时，直接检查M12/S12单个单元格；否则检查到最后一行，避免无效区域报错。
• 修复了公式字符串的转义和括号问题，确保与原正确公式结构一致。
• 添加了ws.Range("B12").Value = ws.Range("B12").Value，将公式计算结果转为单元格的值，移除公式保留最终结果。

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