VBA 数据查找超过了65536行数的限制

yangxuilin

Sub ximing()
   Application.DisplayAlerts = False
   Application.ScreenUpdating = False
Dim dic As Object
Dim crr()
Dim lrow
Set dic = CreateObject("scripting.dictionary")
lrow = Sheets("参数").Cells(Rows.Count, 1).End(xlUp).Row
arr = Sheets("参数").Range("a1:b" & lrow)
Dim i As Long
   For i = 1 To lrow
      dic(arr(i, 1)) = arr(i, 2)
   Next
brr = Sheets("客户").Range("d1:d" & Sheets("客户").Cells(Rows.Count, 1).End(xlUp).Row)
Dim j As Long
ReDim crr(1 To UBound(brr, 1))
   For j = 1 To UBound(brr, 1)
      crr(j) = dic(brr(j, 1))
   Next j
      Sheets("客户").Range("b1:b" & UBound(crr, 1)) = Application.WorksheetFunction.Transpose(crr)
       Application.DisplayAlerts = True
      Application.ScreenUpdating = True
     End Sub
      代码运行在这段就出现了错误：
           Sheets("客户").Range("b1:b" & UBound(crr, 1)) = Application.WorksheetFunction.Transpose(crr) ，
      通过了学习了解是因为Transpose这个函数行数或者列数大于65536时，Transpose函数无法转置成功，
怎么解决转置行数大于65536时的问题？

临沂-枸杞

循环呀

1. Function Transpose2(arr As Variant)
   
2. '******转置函数，单列单行数组不会转置为一维的,没有系统255字符的限制******
   
3. '******CopyRight @ EXCEL880 QQ80871835 百度不到去谷歌*****
   
4. '******这里只考虑一维和二维数组 一维数组直接转为单列二维数组
   
5.     Dim brr(), i, j, n
   
6.     On Error Resume Next
   
7.     n = UBound(arr, 2)
   
8.     If Err = 0 Then n = 2 Else n = 1 '判断维数
   
9.     On Error GoTo 0
   
10.     If n = 1 Then
    
11.         ReDim brr(LBound(arr) To UBound(arr), 1 To 1)
    
12.         For i = LBound(arr) To UBound(arr)
    
13.             brr(i, 1) = arr(i)
    
14.         Next
    
15.     Else
    
16.         ReDim brr(LBound(arr, 2) To UBound(arr, 2), LBound(arr) To UBound(arr))
    
17.         For i = LBound(arr) To UBound(arr)
    
18.             For j = LBound(arr, 2) To UBound(arr, 2)
    
19.                 brr(j, i) = arr(i, j)
    
20.             Next
    
21.         Next
    
22.     End If
    
23.     Transpose2 = brr
    
24. End Function

复制代码

yangxuilin

临沂-枸杞 发表于 2023-8-11 08:23
循环呀

临沂-枸杞老师：我是小白，看不懂，怎么用这段代码？