请各位老师升级一下VBA（VBA只能显示部分功能）

kandhong88

老师：
       想请你升级一下VBA。
       原理如下：
       1.“数据区”内“序号”后有10000列的数据。
       2.实现的效果为：当点击“提取数据”后， 自动在“结果区”内，把和“数据区”相对应“序号”后的数据提取出来。

       目前，此VBA只能提取前20列的数据，多于20列数据时就无能为力了。恳请老师升级VBA。
         提升VBA.rar (463.63 KB, 下载次数: 35)

2019-6-11 14:08 上传

点击文件名下载附件
        

kandhong88

各位老师：
     表格中包含VBA代码如下：（此VBA只能提取前20列的数据，多于20列数据时就无能为力了。恳请老师升级VBA）
Option Explicit
Sub test()
    Dim ar, br, sh As Worksheet, d As Object, i&, k&, s$
   
    br = Sheets("数据区").Range("U4:Ao" & Cells(Rows.count, "dq").End(3).Row)
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(br)
        s = br(i, 1)
        d(s) = i
    Next
    ar = Sheets("结果区").Range("C4:cy" & Cells(Rows.count, "Cy").End(xlUp).Row)
    For i = 1 To UBound(ar)
        s = ar(i, 1)
        If d.exists(s) Then
            For k = 2 To UBound(br, 2)
                ar(i, k) = br(d(s), k)
            Next
        End If
    Next
    Sheets("结果区").Range("C4:cy" & Cells(Rows.count, "Cy").End(xlUp).Row) = ar
    Set d = Nothing
End Sub

hfwufanhf2006

kandhong88 发表于 2019-6-11 14:10
各位老师：
     表格中包含VBA代码如下：（此VBA只能提取前20列的数据，多于20列数据时就无能为力了。恳 ...

下载的附件有病毒，被自动拦截了。

hfwufanhf2006

代码已经把你的数据区锁定了，你自己相应修改下：
    br = Sheets("数据区").Range("U4:Ao" & Cells(Rows.count, "dq").End(3).Row)
U列到Ao列只有20列；

还有，结果区的参数是
ar = Sheets("结果区").Range("C4:cy" & Cells(Rows.count, "Cy").End(xlUp).Row)
c4:cy只有100列左右，远远达不到你说的10000列

老版本的excel最多只有256列，可能作者的excel就是老版本的，没法给你写10000列的区域，是要你自己修改的吧

0126

嗯，就这个建议使用高级筛选或者查找函数，

zjdh

附件中确实有宏病毒！！

zjdh

已被杀毒软件拦截！