使用 VBA 将唯一编号添加到 Excel 数据表答案

【问题标题】：Add unique number to excel datasheet using VBA使用 VBA 将唯一编号添加到 Excel 数据表
【发布时间】：2016-01-19 17:55:50
【问题描述】：

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

感谢任何帮助，谢谢。

【问题讨论】：

你想在哪一列写入concat值，用你当前的代码，单元格E2被覆盖。
@SilentRevolution - 它不会进入 ActiveCell（例如 D2）吗？
@Jeeped，对不起，我看错了，但不，变量，数值写入 d2 而不是 concat 值
concat 最初属于单元格 E2 和 F2，ID=1（单元格 D2）然后我想转到下一行...如果 E3 和 F3 的 concat 是与 E2 和 F2 相同，则 ID 也 =1，如果不是 ID=2（单元格 D3）。然后是下一行。
我明白了，我假设您想将连接的值写入单元格。

标签： vba excel

【解决方案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

【讨论】：

是的，它应该是，第一个连接值获取 ID 1，每个后续连接值与上面不同的值都应该获得不同的 ID。
我发现这个答案是最直观、最容易理解的。它非常适合我想要实现的目标！如果有人认为我的问题有点误导（对此我深表歉意），这应该解释试图产生什么。

【解决方案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

【讨论】：

我喜欢这个功能，如果你不介意我会保存它。最初我的想法和你一样，但是 OP 想要将连接值与上一行中的连接值进行比较。
我的假设是他进行比较以确保第三列中的值是唯一的，这种方式不必检查，它总是会生成一个唯一的 id。
酷，它应该做什么？
@Davesexcel "使用 VBA 向 Excel 数据表添加唯一编号"
是的，我认为 OP 想要为独特的物品设置独特的编号。

【解决方案3】：

如果您向下走 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

【讨论】：

如果列表未排序，则结果不正确。
是的，我很清楚这一点。这一次我的意图是让 OP 的原始方法发挥作用。不要重写它。

【解决方案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

【讨论】：