VBA Excel “error 13: type mismatch”

后端 未结 2 389
失恋的感觉
失恋的感觉 2020-12-21 05:40

I used this code to create 100000 numbers (12 digit unique random numeric numbers )

Sub uniqueramdom()

Const strCharacters As String = \"0123456789\"

Dim c         


        
相关标签:
2条回答
  • 2020-12-21 06:06

    you have hit the limitation of Transpose. the below would work

    Dim arrUnqAlphaNums(1 To 65536 ) As String 'remember the number 65536?
    

    this wont work

    Dim arrUnqAlphaNums(1 To 65537 ) As String 
    

    You will find that this limitation inherited on ranges from prior versions of Excel. Microsoft may have left some business incomplete

    you could probably refactor the code as below

    Option Explicit
    Sub uniqueramdom()
    
        Const strCharacters As String = "0123456789"
    
        Dim strAlphaNum As String
        Dim AlphaNumIndex As Long
        Dim lUbound As Long
        Dim lNumChars As Long
        Dim i As Long
        Dim iRow As Long
        iRow = 1
    
        lUbound = 100000 'Change here your ubound. This can increase execution time.
        lNumChars = Len(strCharacters)
    
        On Error Resume Next
        Do
            strAlphaNum = vbNullString
            For i = 1 To 12
                strAlphaNum = strAlphaNum & Mid(strCharacters, Int(Rnd() * lNumChars) + 1, 1)
            Next i
            Cells(iRow, 1) = strAlphaNum
            iRow = iRow + 1
        Loop While iRow <= lUbound
        On Error GoTo 0
    
    
    End Sub
    
    0 讨论(0)
  • 2020-12-21 06:23

    You were running into an old functional size limitation of application.transpose. If you move to a 2-D array and fill the proper rank, you should not require the use of transpose at all.

    Sub uniqueramdom()
    
        Const strCharacters As String = "0123456789"
    
        Dim cllAlphaNums As Collection
        Dim arrUnqAlphaNums(1 To 100000, 1 To 1) 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, 1)
        lNumChars = Len(strCharacters)
    
        On Error Resume Next
        Do
            strAlphaNum = vbNullString
            For i = 1 To 12
                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) = arrUnqAlphaNums
    
        Set cllAlphaNums = Nothing
        Erase arrUnqAlphaNums
    
    End Sub
    
    0 讨论(0)
提交回复
热议问题