VBA Excel "error 13: type mismatch"

Question

我使用此代码创建了 100000 个数字(12 位唯一随机数字)

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

它适用于:     Dim arrUnqAlphaNums(1 To 50000) As String

但是使用:     Dim arrUnqAlphaNums(1 To 100000) As String ，它不起作用并产生错误:类型不匹配

我这里有以下代码 http://www.excelforum.com/

Answer 1

您已达到 Transpose 的限制。下面的内容可以工作

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

这行不通

Dim arrUnqAlphaNums(1 To 65537 ) As String 

您会发现此限制继承了 Excel 早期版本的范围。微软可能留下了一些未完成的业务

您可能可以重构代码如下

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