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

2024-06-04 19:38:32 浏览数 (3)

标签: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

上述代码将修改后的数据存储在数组中,然后将其复制到工作表指定区域。

0 人点赞