使用VBA为Excel数据表添加唯一编号

I have two columns of numbers, together they will be unique (composite key). I would like to create an unique ID number (third column) similar to how MS Access would use a primary key. I would like to do this in VBA but I am stuck on how to do it.

我有两列数字，它们将是唯一的（复合键）。我想创建一个唯一的ID号（第三列），类似于MS Access如何使用主键。我想在VBA中这样做，但我仍然坚持如何做到这一点。

My VBA in excel isn't very good so hopefully you can see what I've started to attempt. it may be completely wrong... I don't know?

我在excel中的VBA不是很好，所以希望你能看到我开始尝试的东西。这可能完全错了......我不知道？

I don't know how to make the next concatenation and I am unsure about how to go down to the next row correctly.

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

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

any help is appreciated, thanks.

任何帮助表示赞赏，谢谢。

4 个解决方案

#1

Give the code below a try, I've added a loop which executes for each cell in the E Column. It checks if the concat value is the same as the concat value in the row above and then writes the id to the D cell.

尝试下面的代码，我添加了一个循环，它为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

#2

Something like this should work, this will return a Unique GUID (Globally Unique Identifier):

这样的东西应该工作，这将返回一个唯一的GUID（全球唯一标识符）：

Option Explicit
Sub Test()

    Range("F2").Select

    Do Until IsEmpty(ActiveCell)

        If (ActiveCell.Value <> "") Then
            ActiveCell.Offset(0, 1).Value = CreateGUID
        End If
        ActiveCell.Offset(1, 0).Select
    Loop

End Sub
Public Function CreateGUID() As String
    CreateGUID = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
End Function

#3

If you walk down column D and examine the concatenated values from column E and F with the previous row, you should be able to accomplish your 'primary key'.

如果沿着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

#4

You could use collections as well.

您也可以使用集合。

    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

#1