VBA跨工作薄按条件取数

zhaogang1960

ZCJ521 发表于 2012-7-21 18:48
经过初步测式，好像没什么大的问题了，太牛了！唯一的小问题就是还不能选用CTRL键进行多单元格选择取数， ...

如果允许使用CTRL键选，就要个单元格处理数据，对小数据没有问题，但对大数据处理最好不要使用
当然如果要求支持，可以采取逐行复制的方法，程序反而会更简单

zhaogang1960

逐行复制数据，支持不连续区域，缺点速度慢：
Sub Macro1()
    Dim cnn As Object, SQL$, c As Range, rng As Range
    Set rng = Selection
    If rng.Columns.Count = 1 And Not Intersect(rng, [h4:h60000]) Is Nothing Then
        Set cnn = CreateObject("ADODB.Connection")
        cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.Path & "\数据明细表.xlsx"
        For Each c In rng
            SQL = "select f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12,f13 from [" & c.Offset(, -3) & "$b4:n] where f1='" & c & "'"
            c.Offset(, 1).CopyFromRecordset cnn.Execute(SQL)
        Next
        cnn.Close
        Set cnn = Nothing
    End If
End Sub

zhaogang1960

请看附件
支持不连续区域.rar (167.76 KB, 下载次数: 62)

2012-7-21 19:01 上传

点击文件名下载附件

wenwen000424

做个记号，学习一下。

ZCJ521

zhaogang1960 发表于 2012-7-21 19:01
请看附件

真厉害啊，现在代码更少了哦!

fei_2010

站位学习-------------

ZCJ521

zhaogang1960 发表于 2012-7-21 19:01
请看附件

未指定类别，也能取数，能否加个判断，未指定类别，或类别不等于那二个值，给个提示并 不提取数据？

zhaogang1960

ZCJ521 发表于 2012-7-22 11:39
未指定类别，也能取数，能否加个判断，未指定类别，或类别不等于那二个值，给个提示并 不提取数据？

不知所云  

ZCJ521

zhaogang1960 发表于 2012-7-22 11:56
不知所云

总表中E列为类别，类别为空也能取数，铜、铁就是类别，数据明细表各工作表的名称也是按这个类别来分的。

cnjleung

功能强大。