工作薄汇总的问题

谢玉红

附件 工作薄汇总附件.rar (247.57 KB, 下载次数: 9)

2023-2-7 15:32 上传

点击文件名下载附件

谢谢老师！

清风竹-

请看附件。

ykcbf1100

分表行数和列数不限，适用性较好。

fzxba

Sub test1() '
  Dim Conn As Object, rs As Object, strConn As String, SQL As String
  Dim p As String, f As String, i As Integer, j As Integer
  Cells.Clear
  Application.ScreenUpdating = False
  Set Conn = CreateObject("ADODB.Connection")
  strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';Data Source="
  Conn.Open strConn & ThisWorkbook.FullName
  p = ThisWorkbook.Path & "\"
  SQL = "SELECT * FROM [Excel 12.0;HDR=no;Database=" & p & "[f]].[Sheet1$]"
  For j = 1 To 36
    f = Dir(p & j & ".xlsx")
    If Len(f) Then
      Set rs = Conn.Execute(Replace(SQL, "[f]", f))
      Cells(1, 1 + i * 36).CopyFromRecordset rs
      i = i + 1
    End If
  Next
  Set rs = Nothing
  Conn.Close
  Set Conn = Nothing
  Application.ScreenUpdating = True
  Beep
End Sub

kszcs

横向连接各表，留下记号