VBA Excel“错误13：types不匹配”

我用这个代码来创build100000个数字（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 ，它不工作和生产错误：types不匹配

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

Answer 1

你已经达到了转置的限制。 下面会工作

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

这不会工作

 Dim arrUnqAlphaNums(1 To 65537 ) As String 

您会发现这个限制inheritance了以前版本的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的旧function大小限制。 如果你移动到一个二维数组，并填写正确的排名，你根本不需要使用转置。

 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