VBA宏问题：数组传入.Find函数报错，疑循环逻辑错误

看来你在批量用数组值执行Find查找时踩了几个典型的VBA坑，我帮你梳理清楚问题根源，再给出修正后的完整代码：

1. 查找逻辑的循环位置完全错了 #

你原来的代码里，这段循环只是把fnd反复赋值为数组的元素，最后fnd只保留了数组的最后一个值（i从4到135循环结束后，fnd = strArray(135)），真正的查找和统计逻辑却在循环外面——这就导致你只处理了数组的最后一个元素，根本没批量处理所有值，这是报错和功能失效的核心原因：

For i = 4 To 135
 fnd = strArray(i)
Next
' 这里才执行查找，但fnd已经是最后一个元素了
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)

2. 变量类型不匹配导致精度丢失/报错 #

你用Integer来存储求和、平均值、标准差这些结果，但WorksheetFunction.Sum/Average/StDev返回的是Double类型（尤其是标准差，几乎肯定有小数），用Integer存储会直接截断小数，甚至当结果超出Integer范围时直接报错。

3. 重复查找效率极低且易出错 #

在统计循环里，你每次写入结果都重复调用Sheets("Template").Columns("A").Find(strArray(i))，不仅浪费性能，还可能因为Find的默认参数（比如继承上次查找的匹配方式）导致找不到正确的单元格。

4. Find方法缺少关键参数 #

默认的Find会继承上一次查找的参数（比如LookAt是xlPart还是xlWhole，是否区分大小写），如果之前有过其他查找操作，很可能导致这次查找结果不符合预期，必须显式指定关键参数。

修正后的完整代码 #

Sub test()
    Dim fnd As String, FirstFound As String
    Dim FoundCell As Range, rng As Range
    Dim myRange As Range, LastCell As Range
    Dim total As Range ' 修正为Range类型，之前的赋值逻辑有误
    Dim mysum As Double ' 改为Double存储数值结果，避免精度丢失
    Dim myavg As Double
    Dim mymedi As Double
    Dim mystdev As Double
    Dim mycrows As Long
    Dim strArray() As String
    Dim TotalRows As Long
    Dim i As Integer
    Dim templateWS As Worksheet
    Dim targetWS As Worksheet
    
    ' 提前定义工作表对象，减少重复调用Sheets，更高效且不易出错
    Set templateWS = ThisWorkbook.Sheets("Template")
    Set targetWS = ActiveSheet ' 建议改成具体表名，比如ThisWorkbook.Sheets("目标表")
    
    ' 获取Template表A列最后一行的行号
    TotalRows = templateWS.Cells(templateWS.Rows.Count, 1).End(xlUp).Row
    ' 重新定义数组，用更常规的从1开始的索引
    ReDim strArray(1 To TotalRows - 3) ' 因为从第4行开始，所以元素数量是TotalRows-3
    For i = 4 To TotalRows
        strArray(i - 3) = templateWS.Cells(i, 1).Value ' 对应数组索引1到TotalRows-3
    Next
    MsgBox "Loaded " & UBound(strArray) & " items!"
    
    ' 遍历数组中的每个值，逐个执行查找和统计
    For i = 1 To UBound(strArray)
        fnd = strArray(i)
        If fnd = "" Then GoTo NextItem ' 跳过空值，避免无效查找
        
        Set myRange = targetWS.UsedRange
        Set LastCell = myRange.Cells(myRange.Cells.Count)
        Set FoundCell = Nothing
        Set rng = Nothing
        
        ' 显式指定Find的所有关键参数，确保查找准确
        Set FoundCell = myRange.Find( _
            What:=fnd, _
            After:=LastCell, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, ' 精确匹配，如果你需要模糊匹配可以改成xlPart
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False)
        
        ' 检查是否找到当前值
        If Not FoundCell Is Nothing Then
            FirstFound = FoundCell.Address
            Set rng = FoundCell
            
            ' 循环查找所有匹配项，直到回到第一个找到的单元格
            Do
                Set FoundCell = myRange.FindNext(After:=FoundCell)
                If FoundCell.Address = FirstFound Then Exit Do
                Set rng = Union(rng, FoundCell)
            Loop Until FoundCell Is Nothing
        Else
            MsgBox "Value '" & fnd & "' not found in target worksheet!"
            GoTo NextItem
        End If
        
        ' 找到Template表中当前值对应的行，只查找一次
        Dim templateRow As Range
        Set templateRow = templateWS.Columns("A").Find( _
            What:=fnd, _
            LookIn:=xlValues, _
            LookAt:=xlWhole)
        If templateRow Is Nothing Then
            MsgBox "Value '" & fnd & "' not found in Template sheet!"
            GoTo NextItem
        End If
        
        ' 统计signedamount（N列）并写入对应列
        Set total = rng.EntireRow.Columns("N")
        mysum = WorksheetFunction.Sum(total)
        templateRow.Offset(0, 1).Value = mysum ' 写入B列（相对于A列偏移1列）
        myavg = WorksheetFunction.Average(total)
        templateRow.Offset(0, 2).Value = myavg ' 写入C列
        mymedi = WorksheetFunction.Median(total)
        templateRow.Offset(0, 4).Value = mymedi ' 写入E列
        mystdev = WorksheetFunction.StDev(total)
        templateRow.Offset(0, 5).Value = mystdev ' 写入F列
        
        ' 统计crows（H列）
        mycrows = WorksheetFunction.CountIf(targetWS.Range("H2:H1000"), fnd)
        templateRow.Offset(0, 21).Value = mycrows ' 写入V列（偏移21列）
        
        ' 统计amount1（O列）并写入对应列
        Set total = rng.EntireRow.Columns("O")
        mysum = WorksheetFunction.Sum(total)
        templateRow.Offset(0, 11).Value = mysum ' 写入L列
        myavg = WorksheetFunction.Average(total)
        templateRow.Offset(0, 12).Value = myavg ' 写入M列
        mymedi = WorksheetFunction.Median(total)
        templateRow.Offset(0, 14).Value = mymedi ' 写入O列
        mystdev = WorksheetFunction.StDev(total)
        templateRow.Offset(0, 15).Value = mystdev ' 写入P列
        
NextItem:
    Next i
    
    MsgBox "Batch processing completed successfully!"
    Exit Sub
    
NothingFound:
    MsgBox "No values were found in this worksheet"
End Sub

关键改进说明 #

1. 把查找逻辑放到数组循环内部：每个数组元素都单独执行查找和统计，真正实现批量处理
2. 修正变量类型：用Double存储数值统计结果，彻底避免精度丢失和溢出报错
3. 显式指定Find参数：确保查找的准确性，不受之前查找操作的参数影响
4. 提前定义工作表对象：减少重复调用Sheets，代码更高效、可读性更强
5. 添加空值判断：跳过数组中的空值，避免无效查找操作
6. 用Offset代替错误的单元格定位：你原来的Rows.Columns写法是错误的，用Offset可以更直观地控制要写入的列位置

内容的提问来源于stack exchange，提问作者Miklós Suppan