Question

我对vba很新，并尝试编写一段代码，在列中找到副本，然后相应地重命名副本，搜索示例代码但找不到合适的代码！：（

有人可以帮忙吗？

列样本数据......

SAPR1945/1
SAPR1945/1
SAPR1945/1
SAPR1945/1
SAPR1934/3
SAPR1934/3
SAPR1342/2
SAPR1342/2

我需要它看起来如下所示，如果找到重复项，那么第一个单元格中具有重复项的最后一个字符将更改为1，并且该单元格的后续重复项将递增...

SAPR1945/1
SAPR1945/2
SAPR1945/3
SAPR1945/4
SAPR1934/1
SAPR1934/2
SAPR1342/1
SAPR1342/2

希望有道理，有人可以提供帮助吗？

感谢您的期待：）

Answer 1

代码首先遍历A列（从第1行开始），并将/之后的所有数字更改为1。然后它再次遍历列，如果找到重复，那么它会增加超过/符号的数字的计数器。非常直接我认为

Option Explicit

Sub Main()

    Dim ws As Worksheet
    Set ws = Sheets(1)

    Dim i&, j&, cnt&, tmp
    For i = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
        tmp = Split(ws.Range("A" & i).Value, "/")
        ws.Range("A" & i).Value = tmp(0) & "/" & "1"
    Next i
    For i = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
        For j = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
            If i <> j Then
                If ws.Range("A" & i).Value = ws.Range("A" & j).Value Then
                    tmp = Split(ws.Range("A" & i).Value, "/")
                    cnt = tmp(1) + 1
                    ws.Range("A" & j).Value = tmp(0) & "/" & cnt
                End If
            End If
        Next j
        cnt = 0
    Next i

End Sub

Answer 2

您可以使用相同的技术在有或没有代码的情况下执行此操作。下面的代码方法避免了循环。

如果您的数据位于A1:A10，那么：

<强>手册

在B1放=LEFT(A1,FIND("/",A1)) & COUNTIF($A$1:A1,A1)并复制到B10
如有必要，请将结果复制并粘贴回A

<强>码

Sub QuickDupes()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1
.Offset(0, 1).Insert
.Offset(0, 1).FormulaR1C1 = "=LEFT(RC[-1],FIND(""/"",RC[-1])) & COUNTIF(R1C1:RC[-1],RC[-1])"
.Value = .Offset(0, 1).Value
.Offset(0, 1).Delete
End With
End Sub

Excel VBA（重复/增量）

2 个答案: