Хобрук: Ваш путь к мастерству в программировании

Генератор условных случайных серийных номеров VBA не возвращает уникальные значения

Я пытаюсь сгенерировать уникальный случайный серийный номер и вставить его в каждую ячейку в столбце «А» при условии, что у меня есть значение в соответствующей ячейке в столбце «Е», я также использую первую букву из столбца «Е» в готовом серийном номере. . Однако я получаю повторяющиеся значения, например. 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

Большое спасибо за вашу помощь.

07.06.2013

Ответы:


1

Переместите Randomize (Timer) за пределы цикла for. Его нужно инициализировать только один раз.

07.06.2013
  • Спасибо за это предложение. 07.06.2013
  • Еще раз спасибо, по вашему предложению все исправлено, теперь я не получаю повторяющиеся значения. 07.06.2013

  • 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
    
    07.06.2013
  • Спасибо за быстрый ответ! Попробую. 07.06.2013
  • Новые материалы

    Создание кнопочного меню с использованием HTML, CSS и JavaScript
    Вы будете создавать кнопочное меню, которое имеет состояние наведения, а также позволяет вам выбирать кнопку при нажатии на нее. Финальный проект можно увидеть в этом Codepen . Шаг 1..

    Внедрите OAuth в свои веб-приложения для повышения безопасности
    OAuth — это широко распространенный стандарт авторизации, который позволяет приложениям получать доступ к ресурсам от имени пользователя, не раскрывая его пароль. Это позволяет пользователям..

    Классы в JavaScript
    class является образцом java Script Object. Конструкция «class» позволяет определять классы на основе прототипов с чистым, красивым синтаксисом. // define class Human class Human {..

    Как свинг-трейдеры могут использовать ИИ для больших выигрышей
    По мере того как все больше и больше профессиональных трейдеров и активных розничных трейдеров узнают о возможностях, которые предоставляет искусственный интеллект и машинное обучение для улучшения..

    Как построить любой стол
    Я разработчик программного обеспечения. Я люблю делать вещи и всегда любил. Для меня программирование всегда было способом создавать вещи, используя только компьютер и мое воображение...

    Обзор: Машинное обучение: классификация
    Только что закончил третий курс курса 4 часть специализации по машинному обучению . Как и второй курс, он был посвящен низкоуровневой работе алгоритмов машинного обучения. Что касается..

    Разработка расширений Qlik Sense с qExt
    Использование современных инструментов веб-разработки для разработки крутых расширений Вы когда-нибудь хотели кнопку для установки переменной в приложении Qlik Sense? Когда-нибудь просили..