VBA数组写入单元格后COUNTIF返回0问题排查及优化方案

1. 数据类型/格式不兼容：第一个宏直接将Variant类型数组写入Z列时，可能混合了数值、带隐藏字符的文本等非纯文本格式，而COUNTIF对匹配值的类型一致性要求严格，导致无法识别匹配项。
2. 冗余空数据干扰：宏写入Z列时未清理原有数据或数组包含空元素，导致COUNTIF统计范围混入大量空单元格，干扰统计逻辑；手动粘贴会自动覆盖冗余数据，因此恢复正常。
3. 隐藏字符残留：从A列读取任务时可能带入换行符、制表符等不可见字符，宏写入时保留这些字符，而手动复制粘贴会自动清理，导致COUNTIF匹配失败。

方案1：优化第一个宏的写入逻辑，确保Z列数据纯净 #

修改listNotCompletedTasks，强制转换数据为字符串并清理冗余数据：

Sub listNotCompletedTasks()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 指定工作表，避免依赖ActiveSheet
    
    ' 清理Z列原有数据（假设Z1是表头）
    ws.Range("Z2:Z" & ws.Cells(ws.Rows.Count, "Z").End(xlUp).Row).ClearContents
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 仅初始化需要的数组大小
    Dim notCompleted As Variant
    ReDim notCompleted(1 To lastRow - 1, 1 To 1)
    
    Dim i As Long, idx As Long
    idx = 1
    For i = 2 To lastRow
        ' 这里假设完成标记在B列，根据实际情况调整判断条件
        If UCase(Trim(ws.Cells(i, "B").Value)) <> "COMPLETED" Then
            ' 强制转换为字符串并去除首尾空格
            notCompleted(idx, 1) = CStr(Trim(ws.Cells(i, "A").Value))
            idx = idx + 1
        End If
    Next i
    
    ' 仅写入有效数据，避免空行
    If idx > 1 Then
        ws.Range("Z2:Z" & idx + 1).Value = notCompleted
    End If
End Sub

方案2：优化第二个宏的COUNTIF匹配逻辑 #

在listNoDuplicatesAndNoOfInstances中指定精确统计范围，并强制类型匹配：

Sub listNoDuplicatesAndNoOfInstances()
    Dim ws As Worksheet, targetWs As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set targetWs = ThisWorkbook.Worksheets("TargetSheet")
    
    ' 仅取Z列有数据的范围，避免空单元格干扰
    Dim lastZRow As Long
    lastZRow = ws.Cells(ws.Rows.Count, "Z").End(xlUp).Row
    Dim zRange As Range
    Set zRange = ws.Range("Z2:Z" & lastZRow)
    
    ' 提取唯一值到TargetSheet的B列（B2开始）
    zRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=targetWs.Range("B2"), Unique:=True
    
    ' 统计次数到C列
    Dim lastTargetRow As Long
    lastTargetRow = targetWs.Cells(targetWs.Rows.Count, "B").End(xlUp).Row
    Dim j As Long
    For j = 2 To lastTargetRow
        ' 强制转换匹配值为字符串，确保与Z列数据类型一致
        targetWs.Cells(j, "C").Value = WorksheetFunction.CountIf(zRange, CStr(Trim(targetWs.Cells(j, "B").Value)))
    Next j
End Sub

方案3：合并逻辑，完全避免中间列依赖 #

直接在内存中用字典处理未完成任务的唯一值与计数，无需写入Z列，效率更高：

Sub listUniqueUncompletedTasksWithCount()
    Dim ws As Worksheet, targetWs As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set targetWs = ThisWorkbook.Worksheets("TargetSheet")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 用字典统计任务出现次数
    Dim taskDict As Object
    Set taskDict = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    For i = 2 To lastRow
        If UCase(Trim(ws.Cells(i, "B").Value)) <> "COMPLETED" Then
            Dim task As String
            task = CStr(Trim(ws.Cells(i, "A").Value))
            If taskDict.Exists(task) Then
                taskDict(task) = taskDict(task) + 1
            Else
                taskDict(task) = 1
            End If
        End If
    Next i
    
    ' 清理TargetSheet原有数据
    targetWs.Range("B2:C" & targetWs.Cells(targetWs.Rows.Count, "B").End(xlUp).Row).ClearContents
    
    ' 写入结果
    Dim key As Variant, idx As Long
    idx = 2
    For Each key In taskDict.Keys
        targetWs.Cells(idx, "B").Value = key
        targetWs.Cells(idx, "C").Value = taskDict(key)
        idx = idx + 1
    Next key
End Sub

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