VBA中For Each循环搜索WJ短语后无法停止问题求解

核心死循环原因 #

Excel的Find/FindNext遍历完所有匹配单元格后，会自动重新回到第一个匹配的单元格，永远不会返回Nothing，所以你的Do Until Loc Is Nothing判断条件永远无法触发，导致无限循环。

其他代码问题 #

• 变量类型声明错误：Weight、Price、WjSum都是数值类型，声明为String会导致运算异常
• 第21行末尾存在多余的反引号，属于语法错误
• Range("D93")未指定所属工作表，默认写入当前活动工作表，不符合多表遍历的逻辑
• 每次计算结果都直接覆盖D93的值，最终只会保留最后一个匹配项的计算结果，若要累加总和需要调整赋值逻辑
• Find方法未指定完整参数，会继承上一次查找的设置，可能出现匹配结果不符合预期的问题

修正后完整代码 #

Sub Calc()
    Dim Sh As Worksheet
    Dim Loc As Range
    Dim FirstLocAddr As String ' 存储第一个匹配项的地址，用于判断循环终止
    Dim Phrase As String
    Dim OnlyNumber As String
    Dim Weight As Double
    Dim Price As Double
    Dim WeightPrice As Double
    Dim WjSum As Double

    For Each Sh In ThisWorkbook.Worksheets
        With Sh.UsedRange
            ' 明确指定Find的所有关键参数，避免继承之前的设置
            Set Loc = .Cells.Find(What:=" WJ ", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
            If Not Loc Is Nothing Then
                FirstLocAddr = Loc.Address ' 记录第一个匹配项的地址
                Do
                    Phrase = Split(Loc.Value, ".21 ")(1)
                    OnlyNumber = Left(Phrase, Len(Phrase) - 4)
                    Price = Split(OnlyNumber, " ")(1)
                    Weight = Split(OnlyNumber, " ")(0)
                    
                    Select Case Weight
                        Case 0 To 10: WeightPrice = 8
                        Case 10 To 20: WeightPrice = 12
                        Case 20 To 40: WeightPrice = 16
                        Case 40 To 60: WeightPrice = 18
                        Case 60 To 80: WeightPrice = 20
                        Case 80 To 100: WeightPrice = 25
                        Case 100 To 300: WeightPrice = 30
                        Case Is > 300: WeightPrice = 100
                    End Select
                    
                    WjSum = Weight + Price
                    ' 若需要累加所有WJ的总和，改为 Sh.Range("D93").Value = Sh.Range("D93").Value + WjSum
                    Sh.Range("D93").Value = WjSum
                    
                    Set Loc = .FindNext(Loc)
                ' 当FindNext回到第一个匹配项时终止循环
                Loop While Not Loc Is Nothing And Loc.Address <> FirstLocAddr
            End If
        End With
        Set Loc = Nothing
    Next
End Sub

关键修改点说明 #

• 新增FirstLocAddr变量记录第一个匹配项的地址，遍历回到第一个匹配项时自动终止循环，解决死循环问题
• 调整数值相关变量的类型为Double，避免字符串运算错误
• 给Find方法补充了完整的参数，保证查找逻辑稳定
• 替换多层If ElseIf为Select Case，代码可读性更高
• 给Range("D93")补充了工作表前缀Sh.，保证写入当前遍历的工作表
• 移除了多余的语法错误符号

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