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

我有两列数字，它们将是唯一的（复合键）。 我想创build一个唯一的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与前一行的连接值，则应该能够完成“主键”。

 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