Есть ли способ сгенерировать 100K уникальных 8-9 символов в Excel

Question

Я пытаюсь использовать приведенный ниже макрос для создания 100K уникальных IDS / строк в excel.

Однако не удается создать более 34 464 строк. Я получаю "#NA"

Я не эксперт, так что что-то определенно не так.

Любая помощь приветствуется. Спасибо

Sub Random_Number ()

Const strCharacters As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

Dim cllAlphaNums As Collection
Dim arrUnqAlphaNums(1 To 100000) As String
Dim varElement As Variant
Dim strAlphaNum As String
Dim AlphaNumIndex As Long
Dim lUbound As Long
Dim lNumChars As Long
Dim i As Long

Set cllAlphaNums = New Collection
lUbound = UBound(arrUnqAlphaNums)
lNumChars = Len(strCharacters)

On Error Resume Next
Do
    strAlphaNum = vbNullString
    For i = 1 To 9
        strAlphaNum = strAlphaNum & Mid(strCharacters, Int(Rnd() * lNumChars) + 1, 1)
    Next i
    cllAlphaNums.Add strAlphaNum, strAlphaNum
Loop While cllAlphaNums.Count < lUbound
On Error GoTo 0

For Each varElement In cllAlphaNums
    AlphaNumIndex = AlphaNumIndex + 1
    arrUnqAlphaNums(AlphaNumIndex) = varElement
Next varElement

Range("A1").Resize(lUbound).Value = Application.Transpose(arrUnqAlphaNums)

Set cllAlphaNums = Nothing
Erase arrUnqAlphaNums

End Sub *

Answer 1

Просто go 2-мерное с самого начала и не используйте TRANSPOSE():

Sub Random_Number()

    Const strCharacters As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

    Dim cllAlphaNums As Collection
    Dim arrUnqAlphaNums(1 To 100000, 1 To 1) As String '  column-compatible
    Dim varElement As Variant
    Dim strAlphaNum As String
    Dim AlphaNumIndex As Long
    Dim lUbound As Long
    Dim lNumChars As Long
    Dim i As Long

    Set cllAlphaNums = New Collection
    lUbound = UBound(arrUnqAlphaNums, 1)
    lNumChars = Len(strCharacters)

    On Error Resume Next
    Do
        strAlphaNum = vbNullString
        For i = 1 To 9
            strAlphaNum = strAlphaNum & Mid(strCharacters, Int(Rnd() * lNumChars) + 1, 1)
        Next i
        cllAlphaNums.Add strAlphaNum, strAlphaNum
    Loop While cllAlphaNums.Count < lUbound
    On Error GoTo 0

    For Each varElement In cllAlphaNums
        AlphaNumIndex = AlphaNumIndex + 1
        arrUnqAlphaNums(AlphaNumIndex, 1) = varElement
    Next varElement

    Range("A1").Resize(lUbound).Value = arrUnqAlphaNums

    Set cllAlphaNums = Nothing
    Erase arrUnqAlphaNums
End Sub

ПРИМЕЧАНИЕ.

arrUnqAlphaNums было Dim'ed, чтобы колонка была совместима с самого начала.