VBA 条件随机序列号生成器不返回唯一值答案

【问题标题】：VBA conditional random serial number generator doesn’t return unique valuesVBA 条件随机序列号生成器不返回唯一值
【发布时间】：2013-06-07 22:41:05
【问题描述】：

我正在尝试生成唯一的随机序列号，并将其插入到“A”列的每个单元格中，条件是我在“E”列的相应单元格中有一个值，我也使用列中的第一个字母成品序列号中的“E”。 .但是我得到重复的值，例如 SYJ3068 SYJ3068 SNF9678 SNF9678 SNF9678 SGZ5605 SGZ5605 SGZ5605

我一直在寻找解决方案，但没有成功，请您指出正确的方向，并帮助我修复我的代码，以便每个单元格都有唯一的序列号。由于我对 VBA 的了解非常有限，我设法想出了这个：

Sub SumIt()
Dim rRandom_Number As Long
Dim rRandom_1st_Letter As String
Dim rRandom_2nd_Letter As String
Dim rRandom_Serial As String 
Dim CellValue As String
Dim rCell_New_Value As String
Dim RowCrnt As Integer
Dim RowMax As Integer
Dim rCell As Range

With Sheets("Sheet1")

RowMax = .Cells(Rows.Count, "E").End(xlUp).Row
  For RowCrnt = 6 To RowMax
  CellValue = .Cells(RowCrnt, 5).Value
   If Left(CellValue, 1) <> "" Then
   For Each rCell In Range("A6:A" & RowMax)
     Rnd -1
     Randomize (Timer)
     rRandom_Number = Int((9999 + 1 - 1000) * Rnd() + 1000)
     rRandom_1st_Letter = Chr(CInt(Int((90 - 65 + 1) * Rnd() + 65)))
     rRandom_2nd_Letter = Chr(CInt(Int((90 - 65 + 1) * Rnd() + 65)))
     rRandom_Serial = _
     rRandom_1st_Letter _
     & rRandom_2nd_Letter _
     & rRandom_Number
     rCell_New_Value = UCase(Left(Trim(CellValue), 1) & rRandom_Serial)
    .Cells(RowCrnt, 1).Value = rCell_New_Value
  Next
 End If
 Next
End With
End Sub

非常感谢您的帮助。

【问题讨论】：

标签： excel vba

【解决方案1】：

将 Randomize(Timer) 移到 for 循环之外。它只需要初始化一次。

【讨论】：

感谢您的建议。
再次感谢，按照你的建议修复了它，现在我没有得到重复的值。

【解决方案2】：

您可以使用这些加密函数根据两个字符串输入生成唯一的字符串。

Public Function XORDecryption(CodeKey As String, DataIn As String) As String

    Dim lonDataPtr As Long
    Dim strDataOut As String
    Dim intXOrValue1 As Integer
    Dim intXOrValue2 As Integer


    For lonDataPtr = 1 To (Len(DataIn) / 2)
        'The first value to be XOr-ed comes from the data to be encrypted
        intXOrValue1 = Val("&H" & (Mid$(DataIn, (2 * lonDataPtr) - 1, 2)))
        'The second value comes from the code key
        intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))

        strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2)
    Next lonDataPtr
   XORDecryption = strDataOut
End Function

Public Function XOREncryption(CodeKey As String, DataIn As String) As String

    Dim lonDataPtr As Long
    Dim strDataOut As String
    Dim temp As Integer
    Dim tempstring As String
    Dim intXOrValue1 As Integer
    Dim intXOrValue2 As Integer


    For lonDataPtr = 1 To Len(DataIn)
        'The first value to be XOr-ed comes from the data to be encrypted
        intXOrValue1 = Asc(Mid$(DataIn, lonDataPtr, 1))
        'The second value comes from the code key
        intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))

        temp = (intXOrValue1 Xor intXOrValue2)
        tempstring = Hex(temp)
        If Len(tempstring) = 1 Then tempstring = "0" & tempstring

        strDataOut = strDataOut + tempstring
    Next lonDataPtr
   XOREncryption = strDataOut
End Function

【讨论】：

感谢您的快速响应，我会试一试。