0

一意のランダムシリアル番号を生成し、列「E」の対応するセルに値があるという条件に基づいて、列「A」の各セルに挿入しようとしています。列「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

ご協力ありがとうございました。

4

2 に答える 2

1

Randomize(Timer) を for ループの外に移動します。一度だけ初期化する必要があります。

于 2013-06-07T14:36:22.487 に答える
0

これらの暗号化関数を使用して、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
于 2013-06-07T14:41:05.380 に答える