VBA Excel“錯誤13：類型不匹配”

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

Answer 2

您遇到了application.transpose的舊功能大小限制。 如果您移動到二維陣列並填充正確的等級，則根本不需要使用轉置。

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