Question

我有两列数字，它们将是唯一的（复合键）。我想创建一个唯一的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

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

Answer 1

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

Answer 2

这样的事情应该有用，这将返回一个唯一的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

Answer 3

如果你走到D栏并检查E和F列与前一行的连接值，你应该能够完成你的主键＆＃39;。

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

Answer 4

你也可以使用收藏品。

    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

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

4 个答案: