标签:VBA
这个示例很简单,主要是给有兴趣学习VBA的朋友提供研究代码的素材,当然如果有应用场景,那正好适用。
如下图1所示,左侧的数据区域中存在很多重复值,现在要给相同的值添加序号,但每组相同值的序号都要从1开始编号,如图中右侧所示。
图1
代码很简单,如下:
代码语言:javascript复制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
上述代码直接在原数据区域添加序号。
也可以使用下面的代码:
代码语言:javascript复制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
上述代码将修改后的数据存储在数组中,然后将其复制到工作表指定区域。