VBA数组中用CountA判断行内容并删除无效行的问题

核心问题点 #

1. 工作表引用缺失：Range("C" & i & ":M" & i)未指定目标工作表，默认指向当前活动表，若活动表不是数据所在的array_sheet，会导致CountA判断结果错误，无法触发行删除逻辑。
2. 循环语句语法错误：For i = non_rev_rows To 2 Step -1.末尾多了一个英文句号，属于无效语法（虽VBA可能忽略，但会引发潜在执行问题）。
3. 数组与工作表操作脱节：你将数据读入数组后，直接操作工作表行，但未同步维护数组索引与工作表行号的对应关系，且后续数组修改未写回工作表。

修复后的完整代码 #

'Row Count
Dim non_rev_rows As Long
With Sheets("array")
     non_rev_rows = .Range("E" & .Rows.Count).End(xlUp).Row
End With

' 明确指定数据所在工作表，避免引用混淆
Dim array_sheet As Worksheet
Set array_sheet = Sheets("array")

' 读取数据到数组
Dim data As Range
Dim data_range As Variant
Set data = array_sheet.Range("A1:M" & non_rev_rows)
data_range = data.Value

' 修正循环语句，移除末尾无效句号
For i = non_rev_rows To 2 Step -1
    ' Remove Blank Rows from array
    If data_range(i, 2) = "No WBS/CC" Then
        ' 强制指定目标工作表，确保CountA读取正确行数据
        If Application.WorksheetFunction.CountA(array_sheet.Range("C" & i & ":M" & i)) = 0 Then
            array_sheet.Rows(i).Delete
        End If
        
        ' Replace "NO WBS/CC" with Co Code Over-Ride if supplied
        If data_range(i, 13) <> 0 Then
            data_range(i, 2) = data_range(i, 13)
        End If
        
    End If
    
    ' Set Debit / Credit
    data_range(i, 3) = Replace(data_range(i, 3), "Debit", 41)
    data_range(i, 3) = Replace(data_range(i, 3), "Credit", 51)
    
    ' Round to 2 decimal places
    data_range(i, 5) = WorksheetFunction.Round(data_range(i, 5), 2)
    
Next i

' 将数组修改后的内容写回工作表
data.Value = data_range

大数据量优化建议 #

如果你的核心需求是提升处理速度，直接删除工作表行的效率极低（每次删除都会触发工作表重绘），建议改用数组筛选+批量写入的方式：

' 创建新数组存储有效行
Dim new_data As Variant
ReDim new_data(1 To non_rev_rows, 1 To 13) ' 13对应A-M列
Dim new_row As Long
new_row = 1

' 遍历原数组，筛选需要保留的行
For i = 1 To non_rev_rows
    ' 判断条件：不是"No WBS/CC" ，或是但C-M列不为空
    If Not (data_range(i, 2) = "No WBS/CC" And Application.WorksheetFunction.CountA(array_sheet.Range("C" & i & ":M" & i)) = 0) Then
        ' 复制当前行到新数组
        For col = 1 To 13
            new_data(new_row, col) = data_range(i, col)
        Next col
        new_row = new_row + 1
    End If
Next i

' 调整新数组至实际有效行数
ReDim Preserve new_data(1 To new_row - 1, 1 To 13)

' 清空原表数据并批量写入有效行
array_sheet.Range("A1:M" & non_rev_rows).ClearContents
array_sheet.Range("A1").Resize(UBound(new_data, 1), UBound(new_data, 2)).Value = new_data

这种方式避免了多次操作工作表，能大幅提升大数据量下的处理效率，同时准确完成行筛选。

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