使用VBA将唯一编号添加到excel数据表

我有两列数字，它们一起是唯一的（复合键）。我想创建一个唯一的ID号（第三列），类似于MS Access使用主键的方式。我想在VBA中做这件事，但我被困在如何做

我在excel中的VBA不是很好，所以希望您能看到我开始尝试的内容。这可能是完全错误的。。。我不知道

我不知道如何进行下一次连接，也不确定如何正确地下一行

Sub test2()

Dim var As Integer
Dim concat As String

concat = Range("E2").Value & Range("F2").Value

var = 1

'make d2 activecell
Range("D2").Select

Do Until concat = ""
    'if the concat is the same as the row before we give it the same number
    If concat = concat Then
        var = var
    Else
        var = var + 1
    End If
    ActiveCell.Value = var
    ActiveCell.Offset(0, 1).Select
    'make the new concatination of the next row?
Loop
End Sub

---

谢谢你的帮助

类似的方法应该可以工作，这将返回唯一的

GUID

（全局唯一标识符）：

选项显式
子测试（）
范围（“F2”）。选择
直到IsEmpty（ActiveCell）为止
如果是（ActiveCell.Value“”），则
ActiveCell.Offset（0，1）.Value=CreateGUID
如果结束
ActiveCell.Offset（1，0）。选择
环
端接头
作为字符串的公共函数CreateGUID（）
CreateGUID=Mid$（CreateObject（“Scriptlet.TypeLib”）.GUID，2，36）
端函数

如果您沿着D列走下去，检查E列和F列与前一行的连接值，您应该能够完成“主键”

Sub priKey()
    Dim dcell As Range

    With Worksheets("Sheet12")
        For Each dcell In .Range(.Cells(2, 4), .Cells(Rows.Count, 5).End(xlUp).Offset(0, -1))
            If LCase(Join(Array(dcell.Offset(0, 1).Value2, dcell.Offset(0, 2).Value2), ChrW(8203))) = _
               LCase(Join(Array(dcell.Offset(-1, 1).Value2, dcell.Offset(-1, 2).Value2), ChrW(8203))) Then
                dcell = dcell.Offset(-1, 0)
            Else
                dcell = Application.Max(.Range(.Cells(1, 4), dcell.Offset(-1, 0))) + 1
            End If
        Next dcell
    End With
End Sub

---

尝试一下下面的代码，我添加了一个循环，它对

E

列中的每个单元格执行。它检查concat值是否与上面行中的concat值相同，然后将id写入

D

单元格

Sub Test2()
    Dim Part1 As Range
    Dim strConcat As String
    Dim i As Long

    i = 1

    With ThisWorkbook.Worksheets("NAME OF YOUR SHEET")
        For Each Part1 In .Range(.Cells(2, 5), .Cells(2, 5).End(xlDown))
            strConcat = Part1 & Part1.Offset(0, 1)

            If strConcat = Part1.Offset(-1, 0) & Part1.Offset(-1, 1) Then
                Part1.Offset(0, -1).Value = i
            Else
                i = i + 1
                Part1.Offset(0, -1).Value = i
            End If
        Next Part1
    End With
End Sub

---

您也可以使用集合

    Sub UsingCollection()
    Dim cUnique As Collection
    Dim Rng As Range, LstRw As Long
    Dim Cell As Range
    Dim vNum As Variant, c As Range, y

    LstRw = Cells(Rows.Count, "E").End(xlUp).Row
    Set Rng = Range("E2:E" & LstRw)
    Set cUnique = New Collection

    On Error Resume Next
    For Each Cell In Rng.Cells
        cUnique.Add Cell.Value & Cell.Offset(, 1), CStr(Cell.Value & Cell.Offset(, 1))
    Next Cell
    On Error GoTo 0
    y = 1

    For Each vNum In cUnique
        For Each c In Rng.Cells
            If c & c.Offset(, 1) = vNum Then
                c.Offset(, -1) = y
            End If
        Next c
        y = y + 1

    Next vNum

End Sub

---

您想在哪一列中写入

concat

值，使用当前代码，单元格

E2

被覆盖。@SilentRevolution-它不是进入活动单元格（例如D2）吗？@Jeeped，对不起，我读错了，但不是，变量，数值被写入D2而不是concat值

concat

最初是单元格E2和F2，如果ID=1（单元格D2），则我想转到下一行。。。如果E3和F3的

concat

与E2和F2相同，则ID也=1，如果不是ID=2（单元格D3）。然后是下一行。我知道了，我假设你想把连接的值写入单元格。我喜欢这个函数，如果你不介意的话，我会保存它。起初我的想法和你一样，但OP希望将连接值与上面一行中的连接值进行比较。我的假设是，他进行比较是为了确保第三列中的值是唯一的，这种方式不必检查，它将始终生成唯一的id。很酷，但它应该做什么？@DaveXcel“使用VBA将唯一编号添加到excel数据表中“是的，我认为OP希望为唯一的项目提供唯一的编号。是的，应该是这样的，第一个连接的值得到ID 1，每个后续连接的值与上面的值不同，应该得到不同的ID。我发现这个答案是最直观、最容易理解的。它完美地实现了我想要实现的目标！如果有人认为我的问题有点误导性（对此我表示歉意），这应该可以解释我试图产生的结果。如果列表未排序，则结果不正确。是的，我很清楚这一点。这一次我的意图是让OP的原始方法发挥作用；不要重写它。

    Sub UsingCollection()
    Dim cUnique As Collection
    Dim Rng As Range, LstRw As Long
    Dim Cell As Range
    Dim vNum As Variant, c As Range, y

    LstRw = Cells(Rows.Count, "E").End(xlUp).Row
    Set Rng = Range("E2:E" & LstRw)
    Set cUnique = New Collection

    On Error Resume Next
    For Each Cell In Rng.Cells
        cUnique.Add Cell.Value & Cell.Offset(, 1), CStr(Cell.Value & Cell.Offset(, 1))
    Next Cell
    On Error GoTo 0
    y = 1

    For Each vNum In cUnique
        For Each c In Rng.Cells
            If c & c.Offset(, 1) = vNum Then
                c.Offset(, -1) = y
            End If
        Next c
        y = y + 1

    Next vNum

End Sub