Question

我有一个代码可以将表单条目从一个表单复制到另一个表单。我有一个公式来回忆数据。由于VLOOKUP仅在VBA中提取第一个结果，我想看看如何在此公式中指定键值“100”。然后下一次将是“101”等。

我想在每次插入工作表时创建一个唯一值，但不是用户创建的东西。这样我可以使用VLOOKUP查找该唯一值。 理想情况下，行中的第一个单元格是我想放置此值但是当我尝试时，公式就破了。

Sub AddSheet1()

Sheets("Sheet2").Select
Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Activate
Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Sheets("Data").Range("B3").Value
ActiveCell.Offset(0, 1) = Worksheets(3).Range("B4")
ActiveCell.Offset(0, 2) = Worksheets(3).Range("B5")
ActiveCell.Offset(0, 3) = Worksheets(3).Range("B6")
ActiveCell.Offset(0, 4) = Worksheets(3).Range("B7")
ActiveCell.Offset(0, 5) = Worksheets(3).Range("B8")
ActiveCell.Offset(0, 6) = Worksheets(3).Range("B9")
ActiveCell.Offset(0, 7) = Worksheets(3).Range("B10")
ActiveCell.Offset(0, 8) = Worksheets(3).Range("B11")
ActiveCell.Offset(0, 9) = Worksheets(3).Range("B12")
ActiveCell.Offset(0, 10) = Worksheets(3).Range("B13")
ActiveCell.Offset(0, 11) = Worksheets(3).Range("B14")
ActiveCell.Offset(0, 12) = Worksheets(3).Range("B15")

ActiveCell.Offset(0, 13) = Worksheets(3).Range("B17")
ActiveCell.Offset(0, 14) = Worksheets(3).Range("B19")

ActiveCell.Offset(0, 15) = Worksheets(3).Range("B20")
ActiveCell.Offset(0, 16) = Worksheets(3).Range("B21")
ActiveCell.Offset(0, 17) = Worksheets(3).Range("B22")
ActiveCell.Offset(0, 18) = Worksheets(3).Range("B23")
ActiveCell.Offset(0, 19) = Worksheets(3).Range("B24")
ActiveCell.Offset(0, 20) = Worksheets(3).Range("B25")
ActiveCell.Offset(0, 21) = Worksheets(3).Range("B26")
ActiveCell.Offset(0, 22) = Worksheets(3).Range("B27")
ActiveCell.Offset(0, 23) = Worksheets(3).Range("B28")
ActiveCell.Offset(0, 24) = Worksheets(3).Range("B29")
ActiveCell.Offset(0, 25) = Worksheets(3).Range("B30")
ActiveCell.Offset(0, 26) = Worksheets(3).Range("B31")
ActiveCell.Offset(0, 27) = Worksheets(3).Range("B32")
ActiveCell.Offset(0, 28) = Worksheets(3).Range("B33")
ActiveCell.Offset(0, 29) = Worksheets(3).Range("B34")
ActiveCell.Offset(0, 30) = Worksheets(3).Range("B35")

If Range("B37") = "" Then
    ActiveCell.Offset(0, 31) = ""
Else
    ActiveCell.Offset(0, 31) = Worksheets(3).Range("B37")
End If
End Sub

Answer 1

使用此公共'帮助'功能创建GUID。

Option Explicit

Function CreateGUID(Optional wrappingBraces As Boolean = False)
    Static obj As Object
    Set obj = CreateObject("Scriptlet.TypeLib")
    If wrappingBraces Then
        CreateGUID = obj.GUID
    Else
        CreateGUID = Mid(obj.GUID, 2, Len(obj.GUID) - 4)
    End If
End Function

使用as，

ActiveCell.Offset(0, 31) = CreateGUID()  'creates something like 904A8B8D-5EDE-4867-AF19-1BA9A46D9AD6

Answer 2

Jeeped提出的CreateGUID值回答完全可以实现。但是如果您正在寻找关于如何记录和记录新值以便于参考的简单建议，我建议使用简单的自动填充引物值。您所要做的就是在第一个单元格中设置初始值（例如100），并在新添加的数据上向下自动填充。这也取决于你的需求。如果您定期添加数据（例如每天），则可以将日期设置为标识符值，以了解添加数据的日期。在这种情况下，您将能够根据日期快速参考添加的值。

顺便说一句，您可以缩短代码以复制值。 IF将有助于停止复制空单元格。这假设您的数据源是单列。如果您有多个列，则可以通过以相同方式添加嵌套while循环来编辑代码。

Sheets("Sheet2").Select
Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Activate
Dim CopyRange As Range
Set CopyRange = Sheets(2).Range("B3:B35")
pastecol = 1
copyrow = 1
copycol = 2 
For copyrow = 1 to  CopyRange.Rows.Count
    If Not IsEmpty(CopyRange(copyrow, copycol)) Then
        ActiveCell.Offset(0, pastecol) = CopyRange(copyrow, copycol)
        pastecol = pastecol + 1
    End If
Next

添加“关键”唯一值

2 个答案: