如何使用 VBA 代码添加唯一的序列号

Question

B 列中有一些值（例如员工编号）。很少有数字重复。我想为每个唯一的员工 ID 提供唯一的序列号。就像员工 A 编号 1，员工 B-2，如果 A 再次出现在下一个单元格中，则再次将序列号设为 1。 我试过下面的代码，请帮忙。 代码：

Sub add_serial_number()
    Dim i As Long
    For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(i, "B").Value <> "" Then
            Cells(i, "A").Value = i - 1
        End If
    Next i
End Sub

Answer 1

我很快就完成了，修改了我找到的代码 here 并且不得不考虑 它也是，并且还使用了“技巧”，但我认为这就是您想要的。它给了我你想要的结果。

Sub add_sbFindDuplicatesInColumn5()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
lastRow = Range("B65001").End(xlUp).Row 'changed it to +1 of the lookup range to catch all values .

For iCntr = 1 To lastRow

If Cells(iCntr, 2) <> "" Then
    
       
    matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
    
    If iCntr = matchFoundIndex Then
        Cells(iCntr, 1).Value = iCntr - 1
        
       Else:
          Cells(iCntr, 1) = "Duplicate - " & WorksheetFunction.Index(Range("A1:A65000"), WorksheetFunction.Match(Cells(iCntr, 2).Value, Range("B1:B65000"), 0))

    'delete "Duplicate - " & in your case if you chose to do with it. it wont be neccissary. Was for testing.

    End If
End If


Next
End Sub

我说“使用了一个技巧”，因为我认为我应该将重复项及其 ID 存储在他们自己的数组中，我认为您“应该”这样做以获得正确的工作答案并对它们进行检查并分配这样的相关值。相反，我正在做的（由于我有时间限制） - 用index matchWorksheetFunction 查找它们。但我认为现在我在绕圈子，这就是 excel 的目的。该代码似乎正是您想要的。做这项工作。唯一的问题是它如何处理超过 20k 行和 8GB 内存？

在任何情况下，对于我的数据，每个人都会得到一个唯一的 id，除非他们是重复的，在那里他们会得到重复值 id 的原始第一个实例。

它对我有用。对你起作用吗 ？我认为我的答案是最合乎逻辑/最简单的答案，您甚至不需要在您的数据中进行任何特殊排序，这是我可以在半小时内完成的最快的解决方案（减去那个数组的想法）。告诉我。

哦，不。它确实会获取每个重复项并将 id 分配给除最后一个以外的所有值，因为查找当然不会在它下面找到更多。我现在正在床上睡觉，明天我也会努力让它为最后一点工作。

好的。我想我也解决了这个范围的问题。只需确保您的最后一行比您的查找范围多 1 行。然后它将捕获该范围内的所有内容（ID 和 dup）。如果有人对此有更优雅、更通用（且硬编码更少）的解决方案，请告诉我。

Answer 2

通过 Hook 或 By Crook 我得到了它的工作。得到了你想要的，并且没有字典，没有使用数组，字典或键（这将是我感觉更好的方式，但现在对我来说太头疼了）。必须明白我被砸了，我住的地方快把我逼疯了，需要一个假期。

它是以“作弊”的方式完成的（通过 VBA 工作表公式 - 这不是作弊，但正是我的想法），而不是我正在查看的数组/字典 Here、Here 和 Here，它更少我觉得通用且不太稳定，因此每次运行时都必须清除 A 列，否则某些 id 每次都会 +1，如果你在其他之间添加一个值，则 id 会改变。因此，这实际上只适用于第一次获得 ID、保存以及您添加的任何新 ID，除非它们低于所有其他 ID。会改变id的。仅在列表中的其他下方添加新值，而不是在中间添加新值（否则它仍然有效，但您会丢失（更改）一些 ID，如果您添加新值并在最后运行其他任何地方，您最终会更改它们的最后一个条目/值）

因此，如果您实际上没有按顺序添加值，而是将它们添加到中间的某个位置，是的，它们仍然会获得一个 id（与所有其他人一样），但这些 id 不会稳定（它们可能与以前不同)。

ERGO：是的，Dictionary Array 会更好（并且更快）ergo 请确保按顺序添加（在最后一个条目下方有或没有空白单元格 - 那些无关紧要）而不是在中间，否则在第 2 和第 3这样做你会改变一些 id 的。适合 1 次使用然后保存，也适合按顺序添加条目，但不适合在列中的任何位置添加条目，这将更改 ID（尽管仍为该实例创建正确的条目）。也许这就是你想要的？ id 会根据您的操作而改变。

Sub add_my_serial_numbers()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long

Range("A:A").Cells.Clear 'Very Important if your going to be using this code to make your serial #'s. For the process/code to work properly, the serial numbers must be cleared everytime you run. its part of the process and ensures it works.

lastRow = Range("B65001").End(xlUp).Row 'changed it to +1 of the lookup range to catch all values .

For iCntr = 1 To lastRow

If Cells(iCntr, 2) <> "" Then
    
    matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
    
    arr = Array(matchFoundIndex)
    
    If iCntr = matchFoundIndex Then
       If WorksheetFunction.CountIf(Range("B1:B" & lastRow), Cells(iCntr, 2)) = 1 Then
       Cells(iCntr, 1).Value = WorksheetFunction.Max(Range("A1:A" & iCntr - 1)) + 1
       Else
       
        Cells(iCntr, 1).Value = WorksheetFunction.Max(Range("A1:A" & iCntr)) + 1

        End If
       
       Else:
       
          Cells(iCntr, 1) = WorksheetFunction.Index(Range("A1:A65000"), WorksheetFunction.Match(Cells(iCntr, 2).Value, Range("B1:B65000"), 0))

    'delete "Duplicate - " & in your case if you chose to do with it. it wont be neccissary. Was for testing.
     'warning this code will not work the same or at all with strings so removed deletes which where unneccisary anyway.

    End If
End If

Next
End Sub

/ 实在看不下去了。是整个地区和邻居，数百人和音乐。我要吃饭了。

但它似乎可以按你的需要工作。

add-unique-number-to-excel-datasheet-using-vba

add-unique-id-to-list-of-numbers-vba

quicker-way-to-get-all-unique-values-of-a-column-in-vba

get-the-nth-index-of-an-array-in-vba

using dictionaries youtube

Very Good Video by Leila Gharani

vba-how-do-i-get-unique-values-in-a-column-and-insert-it-into-an-array

how-to-extract-a-unique-list-and-the-duplicates-in-excel-from-one-column

以上所有优秀的阅读，都与我正在阅读和尝试的内容有关（但放弃了）。但是dicts是解决这个问题的方法。

& 可惜你&我没有Office 365，你可以很容易地使用它的Unique 功能来帮助你做到这一点。 （但即使他们把它给了我，我也不认为 id 喜欢它。它太“app-y”了）。

Extract-unique-values-in-excel-using-one-function.html

这是我运行代码后数据的屏幕截图（有效）。

总而言之，它是一种在电子表格上创建 id 的技巧。这不是很好的代码。根本不是最好的（字典和键是最好的）。也不是最快的，不会将这些 ID 后端分配给任何 storage ，也不会将它们固定在石头上（这是您理想地创建 id 所需要的），但它确实为您提供了创建工作“id”的功能" 在您的工作电子表格上作为您的工作（即至少为您提供您暂时要求的内容。适用于具有类似要求的工作电子表格）。

使用我的代码创建它们后，您可以将它们传递给一个数组（非常简单），其中包含与另一个 sub 相关的行和列，并在以后对它们进行更稳定的工作。但它可以很好地维持并运行良好，因为它/它的设计目的。

你也可以看到我的测试。图片 3..Col I：我在 B 列中的唯一值，Col J：B 中这些的计数，在 Col H 中：列表中的第 n 个数字/它们出现的顺序。