循环遍历范围并根据计数

Question

搜索网络和SO，但无法找到帮助我的答案。希望一个直接的问题可以导致社区启蒙。

我想创建通过范围（列标题）查找的代码，检测重复项，然后使用计数附加每个副本。

例如，我的列标题如下所示：

• 供应商
• 追踪号码
• 显示在
• 类型
• 呼叫报告标志
• 类型
• 由于
• 创建者
• 创建
• 创建者
• 创建

运行代码后，我希望它们看起来像这样：

• 供应商
• 追踪号码
• 显示在
• 类型1
• 呼叫报告标志
• 2型
• 由于
• Created By1
• Created1
• Created By2
• Created2

单独留下非重复内容，当前计数附加了重复项。

我尝试了一些代码，并且对于我的范围内的每个单元格使用＆＃39;计算重复次数＃但是一旦它附加了计数，它就不再将它视为重复，所以当它移动到下一个单元格时它就不会被追加。

这是我的代码（虽然我认为我可能需要从不同的策略开始）：

Sub TestSub（）

Dim Counter As Integer
Dim Cell As Range
Dim Headers As Range

Set Headers = Worksheets("TEST SHEET").UsedRange.Rows("1:1")
Counter = 1

For Each Cell In Headers.Cells.Value
    If WorksheetFunction.CountIf(Headers, Cell.Value) > 1 Then
        Cell.Value = Cell.Value & Counter
    End If
    Counter = Counter + 1
Next Cell

End Sub

希望有人能提供帮助。

Answer 1

这使用了这个公式的基础：

=IF(COUNTIF(1:1,A1)>1,A1&COUNTIF($A$1:A$1,A1),A1)

做你想做的事：

Sub TestSub()

Dim Cell As Range
Dim Headers As Range
Dim Headers2 As Range
With Worksheets("TEST SHEET")
    Set Headers = .UsedRange.Rows("1:1")
    Headers.Copy .Range("A" & Worksheets("Sheet3").Rows.Count)
    Set Headers2 = .UsedRange.Rows(.Rows.Count & ":" & .Rows.Count)

    For Each Cell In Headers.Cells
        If WorksheetFunction.CountIf(Headers2, Cell.Value) > 1 Then
            Cell.Value = Cell.Value & WorksheetFunction.CountIf(Range("A" & .Rows.Count, .Cells(.Rows.Count, Cell.Column)), Cell.Value)
        End If
    Next Cell
    Headers2.ClearContents

End With
End Sub

我们需要将标题复制到另一个位置，以便在COUNTIF（）中使用。否则，一旦第一次改变，其他任何一个都不会相等，并且countif找不到多个。