Question

我正在尝试生成唯一的随机序列号并将其插入到列“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

非常感谢你的帮助。

Answer 1

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

Answer 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

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

2 个答案: