For每个循环不停止在VBA

Question

我有一个Excel代码写在VBA。我想在列中找到短语WJ，并从中选择适当的值。我在For Each循环中这样做，但循环在搜索所有WJ短语后不会停止。

Sub Calc()
Dim Sh As Worksheet
Dim Loc As Range
Dim Phrase As String
Dim OnlyNumber As String
Dim Weight As String
Dim Price As String
Dim WeightPrice As String
Dim WjSum As String
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
Set Loc = .Cells.Find(What:=" WJ ")
If Not Loc Is Nothing Then
Do Until Loc Is Nothing
Phrase = Split(Loc.Value, ".21 ")(1)
OnlyNumber = Left(Phrase, Len(Phrase) - 4)
Price = Split(OnlyNumber, " ")(1)
Weight = Split(OnlyNumber, " ")(0)`

If Weight > 0 And Weight <= 10 Then
WeightPrice = 8
ElseIf Weight > 10 And Weight <= 20 Then
WeightPrice = 12
ElseIf Weight > 20 And Weight <= 40 Then
WeightPrice = 16
ElseIf Weight > 40 And Weight <= 60 Then
WeightPrice = 18
ElseIf Weight > 60 And Weight <= 80 Then
WeightPrice = 20
ElseIf Weight > 80 And Weight <= 100 Then
WeightPrice = 25
ElseIf Weight > 100 And Weight <= 300 Then
WeightPrice = 30
ElseIf Weight > 300 Then
WeightPrice = 100
End If

WjSum = Weight + Price

Range("D93").Value = WjSum

Set Loc = .FindNext(Loc)
Loop
End If
End With
Set Loc = Nothing
Next
End Sub

Answer 1

下面是简化后的代码片段

Sub FindAllInUsedRange()
Dim usedRange As Range
Set usedRange = ActiveSheet.usedRange
Debug.Print usedRange.Address

Dim firstFoundAddress As String
Dim foundRange As Range
Set foundRange = usedRange.Find("a")
firstFoundAddress = foundRange.Address
Do
'Do something useful with foundRange
Debug.Print foundRange.Address
Set foundRange = usedRange.FindNext(foundRange)
Loop While foundRange.Address <> firstFoundAddress
End Sub

编辑源excel表

<表类>Btbody><<tr>12b34b56b