VBA Excel “error 13: type mismatch”

问题:

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

Sub uniqueramdom()

Const strCharacters As String = "0123456789"

Dim cllAlphaNums As Collection
Dim arrUnqAlphaNums(1 To 60000) 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 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) = varElement
Next varElement

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

Set cllAlphaNums = Nothing
Erase arrUnqAlphaNums

End Sub

It works with:     Dim arrUnqAlphaNums(1 To 50000) As String

But with:     Dim arrUnqAlphaNums(1 To 100000) As String , it not working and producing Error : type mismatch

I have the following code in here http://www.excelforum.com/

回答1:

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

回答2:

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