多个excel中相同条件格式的数据如何汇总呢？

dpf

如图所示excel表格，大概有100个的样子，每个表格记录着最新的数据，比如就是想汇总“支撑2-04”中的“轴力（t）”其对应的“20：00”的所有数据到一个文件中，前提条件有三个“支撑2-04”、“轴力（t）”、“20：00”，想把满足这三个条件的所有数据汇总到一个表格里；这样的数据规则是统一的，但是因为数据不断的更新，不确定数据的具体单元格位置，请问应该如何操作这种跨表格的数据汇总呢？


提问报表1～3.zip (122.38 KB, 下载次数: 4)

2018-6-11 09:00 上传

点击文件名下载附件

z403025335

Sub 汇总()
Dim q As FileDialog, wall As Workbook, w1 As Workbook
Dim s$, i%, x&, y&
Set q = Application.FileDialog(1)
    q.Title = "请选中您要汇总的所有文件"
    q.AllowMultiSelect = True
If q.Show = -1 Then
    s = InputBox("请选中要汇总的单元格地址", 输入地址, "A1")
    Set wall = Workbooks.Add
    With wall.Sheets(1)
    For i = 1 To q.SelectedItems.Count
        Set w1 = Workbooks.Open(q.SelectedItems(i))
            y = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
            x = .Cells(Rows.Count, y).End(xlUp).Row + 1
            .Cells(x, y) = w1.Range(s)         w1.close
    Next i
End If
            
End Sub

z403025335

Sub 汇总()
Dim q As FileDialog, wall As Workbook, w1 As Workbook
Dim s$, i%, x&, y&
Set q = Application.FileDialog(1)
    q.Title = "请选中您要汇总的所有文件"
    q.AllowMultiSelect = True
If q.Show = -1 Then
    s = InputBox("请选中要汇总的单元格地址", 输入地址, "A1")
    Set wall = Workbooks.Add
    With wall.Sheets(1)
    For i = 1 To q.SelectedItems.Count
        Set w1 = Workbooks.Open(q.SelectedItems(i))
            y = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
            x = .Cells(Rows.Count, y).End(xlUp).Row + 1
            .Cells(x, y) = w1.Range(s)           w1.close
    Next i
End If
            
End Sub

lsc900707

可惜只有一个表有数据，举例能不能多一点。

dpf

lsc900707 发表于 2018-6-11 06:47
可惜只有一个表有数据，举例能不能多一点。

你好，报表都是基本差不多的，我放了3个报表上来给您看一下。
提问报表1～3.zip (122.38 KB, 下载次数: 4)

2018-6-11 08:59 上传

点击文件名下载附件

dpf

z403025335 发表于 2018-6-10 23:29
Sub 汇总()
Dim q As FileDialog, wall As Workbook, w1 As Workbook
Dim s$, i%, x&, y&

谢谢，我研究一下，有不明白的地方再请教您。

LMY123

dpf 发表于 2018-6-11 09:30
谢谢，我研究一下，有不明白的地方再请教您。

1. Sub 合并多薄首表不连续单元格()
   
2.     Dim Fso As Object, File As Object, cnn As Object, rs As Object, SQL$, m&, arr()
   
3.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
4.     ReDim arr(1 To Fso.GetFolder(ThisWorkbook.Path).Files.Count, 1 To 13)
   
5.     For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
   
6.         If File.Name Like "*.xlsx" Then
   
7.             m = m + 1
   
8.             Set cnn = CreateObject("ADODB.Connection")
   
9.             cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & File
   
10.             arr(m, 1) = Split(File.Name, ".")(0)
    
11.             Set rs = cnn.Execute("SELECT * FROM [$G9:G9]")
    
12.             arr(m, 2) = rs.Fields(0)
    
13. '            Set rs = cnn.Execute("SELECT LAST(F2) FROM [Sheet1$A1:B100] ")
    
14. '            arr(m, 3) = rs.Fields(0)
    
15. '            Set rs = cnn.Execute("SELECT F2 FROM [Sheet1$A1:B100] WHERE F1 LIKE '%" & Split(Cells(1, 4), "/")(2) & "'")
    
16. '            arr(m, 4) = rs.Fields(0)
    
17.         End If
    
18.     Next
    
19.     ActiveSheet.UsedRange.Offset(1).ClearContents
    
20.     If m > 0 Then [a2].Resize(m, 13) = arr
    
21.     rs.Close
    
22.     cnn.Close
    
23.     Set rs = Nothing
    
24.     Set cnn = Nothing
    
25.     Set Fso = Nothing
    
26. End Sub
    
27. 'http://club.excelhome.net/forum.php?mod=viewthread&tid=1221645
    

复制代码

LMY123

dpf 发表于 2018-6-11 09:30
谢谢，我研究一下，有不明白的地方再请教您。

ADO合并多薄首表不连续单元格.rar (134.85 KB, 下载次数: 24)

2018-6-11 11:25 上传

点击文件名下载附件

dpf

LMY123 发表于 2018-6-11 11:25

谢谢您的表格，很大程度上给我解惑了，我还有一点小疑问：
如果我想提取其他更大的数值，比如AD175，如何修改才能避免“超出定义单元范围呢”？我尝试修改了几个数字，改的小就没问题，改的大就会溢出，这块如何解决呢？

同时想请教一下，如果我报表里的单元格是变的，我是想根据“支撑4-05”的条件找到其对应的行的某个数值，应该怎么样定位更好呢？

jjmysjg

z403025335 发表于 2018-6-10 23:27
Sub 汇总()
Dim q As FileDialog, wall As Workbook, w1 As Workbook
Dim s$, i%, x&, y&

       w1.close