提取数据

fzkoko

不错，学习

张雄友

zhaogang1960 发表于 2013-7-18 23:02
SQL联合查询，要求不超过49个工作表：

SQL联合查询 对同一工作簿的工作表不能超过49个，但

SQL联合查询对不同工作簿的，工作簿的个数可以超过49个，

对不对？

虎啸glq

zhaogang1960 发表于 2013-7-18 23:18
复制一个表头:

老师求助二表数据（绿色部分）提取汇总在一张表上，请赐教！ 数据字段提取.rar (48.85 KB, 下载次数: 6)

2013-9-1 22:54 上传

点击文件名下载附件

zhaogang1960

请看附件
数据字段提取.rar (61.17 KB, 下载次数: 25)

2013-9-1 23:35 上传

点击文件名下载附件

zhaogang1960

虎啸glq 发表于 2013-9-1 22:54
老师求助二表数据（绿色部分）提取汇总在一张表上，请赐教！

1. Sub 宏1()
   
2.     Dim arr, brr, crr(1 To 100000, 0 To 12), lr&, i&, j&, r, f&, m&, d As Object, sh As Worksheet
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For Each sh In Sheets(Array("数据1", "数据2"))
   
5.         With sh
   
6.             lr = .Range("c" & Rows.Count).End(xlUp).Row
   
7.             If .Name = "数据1" Then
   
8.                 arr = .Range("c7:c" & lr)
   
9.                 brr = .Range("NV7:OG" & lr)
   
10.             Else
    
11.                 arr = .Range("c5:c" & lr)
    
12.                 brr = .Range("OE5:OP" & lr)
    
13.             End If
    
14.         End With
    
15.         For i = 1 To UBound(arr)
    
16.             r = d(arr(i, 1))
    
17.             If r = "" Then
    
18.                 m = m + 1
    
19.                 d(arr(i, 1)) = m
    
20.                 crr(m, 0) = arr(i, 1)
    
21.                 For j = 1 To 12
    
22.                     crr(m, j) = brr(i, j)
    
23.                 Next
    
24.             Else
    
25.                 For j = 1 To 12
    
26.                     crr(r, j) = crr(r, j) + brr(i, j)
    
27.                 Next
    
28.             End If
    
29.         Next
    
30.     Next
    
31.     With Sheets("二表数据汇总提取")
    
32.         .UsedRange.Offset(1).ClearContents
    
33.         .[a2].Resize(m, 13) = crr
    
34.     End With
    
35. End Sub
    

复制代码

LMY123

For Each tb1 In cat.Tables