同一文件夹下多文件查找汇总

LMY123

xiaofanpark 发表于 2018-8-17 15:15
您好，您这边我由于没学过sql语句，没咋看懂- -
我这边的思路是这样的，先是获取文件夹内分表的数目，然 ...

Sub ADO纵向合并多薄首表多区域()
  Dim Fso As Object, File As Object, cnn As Object, SQL$, m&
  Application.ScreenUpdating = False
  Set Fso = CreateObject("Scripting.FileSystemObject")
  ActiveSheet.UsedRange.Clear
  For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
  If File.Name Like "*.xlsx" And File.Name <> ThisWorkbook.Name Then
    m = m + 1
    If m = 1 Then
      Set cnn = CreateObject("adodb.connection")
       cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & File
      SQL = "select F1,F2,F3 from [A2:E] where f2 is not null"
      Sheets("出货统计").[A1].CopyFromRecordset cnn.Execute(SQL)
      SQL = "select F1,F4,F5 from [A2:E] where f4 is not null"
      Sheets("出货统计").Range("a65536").End(3).Offset(1, 0).CopyFromRecordset cnn.Execute(SQL)
      
      SQL = "select F2 from [H1:I1] "
      With Sheets("出货统计")
        .[D1].CopyFromRecordset cnn.Execute(SQL)
        R = .Range("D65536").End(3).Row + 1
        For X = R To .Range("a65536").End(3).Row
          .Cells(X, 4) = .Cells(R - 1, 4)
        Next
      End With
    Else
      SQL = "select F1,F2,F3 from [Excel 12.0;hdr=no;Database=" & File & ";].[A2:E] where f2 is not null"
      Sheets("出货统计").Range("a65536").End(3).Offset(1, 0).CopyFromRecordset cnn.Execute(SQL)
      SQL = "select F1,F4,F5 from [Excel 12.0;hdr=no;Database=" & File & ";].[A2:E] where f4 is not null"
      Sheets("出货统计").Range("a65536").End(3).Offset(1, 0).CopyFromRecordset cnn.Execute(SQL)
      
      SQL = "select F2 from [Excel 12.0;hdr=no;Database=" & File & ";].[H1:I1] "
      With Sheets("出货统计")
        .Range("D65536").End(3).Offset(1, 0).CopyFromRecordset cnn.Execute(SQL)
        R = .Range("D65536").End(3).Row + 1
        For X = R To .Range("a65536").End(3).Row
          .Cells(X, 4) = .Cells(R - 1, 4)
        Next
      End With
    End If
  End If
  Next
  Set Fso = Nothing
  cnn.Close
  Set cnn = Nothing
  Application.ScreenUpdating = True
End Sub
'http://club.excelhome.net/thread-1145518-1-1.html
'http://club.excelhome.net/forum.php?mod=viewthread&tid=433987&extra=page%3D1
Sub 行列转制2()
    Cells.Clear
    Set rngt = Sheets("出货统计").Range("a1").CurrentRegion
    Dim cnn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & ThisWorkbook.FullName
    strSQL = "TRANSFORM FIRST(F1) SELECT F4 FROM [出货统计$] GROUP BY F4 PIVOT F3&CHR(10)&F2"
    rs.Open (strSQL), cnn, 3, 1
    For Each Field In rs.Fields
        aa = Field.Name
        Sheets("结果").[A1].Offset(0, i) = Field.Name
        i = i + 1
    Next
    Sheets("结果").Range("A2").CopyFromRecordset rs
    Set rs = Nothing
    Set cnn = Nothing
    Sheets("结果").[A1] = "零件名称"
End Sub

LMY123

xiaofanpark 发表于 2018-8-17 15:15
您好，您这边我由于没学过sql语句，没咋看懂- -
我这边的思路是这样的，先是获取文件夹内分表的数目，然 ...

参考：

001.rar (42.81 KB, 下载次数: 47)

2018-8-17 16:16 上传

点击文件名下载附件

xiaofanpark

LMY123 发表于 2018-8-17 16:16
参考：

好的，谢谢您了，我再研究研究