使用VBA给多组重复值添加序号

Sub AddNumber()
 Dim strOldValue As String
 Dim rngCell As Range
 Dim rngData As Range
 Dim varSearch As Variant
 Dim i As Long
 Dim j As Long
 
 Set rngData = ActiveSheet.Range("B2:B9")
 varSearch = Array("白鹤滩", "三峡")
 
 For j = LBound(varSearch) To UBound(varSearch)
   i = 1
   For Each rngCell In rngData
     strOldValue = rngCell.Value
     rngCell.Replace What:=varSearch(j), Replacement:=varSearch(j) & i
     If strOldValue <> rngCell.Value Then i = i + 1
   Next rngCell
 Next j
End Sub

Sub AddNumber2()
 Dim varSearch As Variant
 Dim i As Long
 Dim m As Long
 Dim n As Long
 
 varSearch = ActiveSheet.Range("B2:B9")
 
 For i = 1 To UBound(varSearch)
   If InStr("白鹤滩三峡", varSearch(i, 1)) Then
     If varSearch(i, 1) = "白鹤滩" Then m = m + 1
     If varSearch(i, 1) = "三峡" Then n = n + 1
     varSearch(i, 1) = varSearch(i, 1) & IIf(varSearch(i, 1) = "白鹤滩", m, n)
   End If
 Next i
 ActiveSheet.Range("D2:D9") = varSearch
End Sub