求助老铁们多工作表汇总 VBA代码

LIUZHU

lpflbc 发表于 2023-1-10 15:20
你发的附件没有代码，你是不是发错了

WPS打开，然后运行JS宏，亲

lpflbc

LIUZHU 发表于 2023-1-10 15:22
WPS打开，然后运行JS宏，亲

我用的是excel,能运行吗？

ykcbf1100

lpflbc 发表于 2023-1-10 14:50
你这汇总好像不对

不好意思，刚才没核对。
代码已更新。

lpflbc

ykcbf1100 发表于 2023-1-10 15:33
不是排重汇总？

我的意思是每种书汇总数（所有学校的学生数汇总到一起）

ykcbf1100

lpflbc 发表于 2023-1-10 15:40
我的意思是每种书汇总数（所有学校的学生数汇总到一起）

代码已更新。

fzxba

仅供测试.rar (199.59 KB, 下载次数: 25)

2023-1-10 15:48 上传

点击文件名下载附件

lpflbc

ykcbf1100 发表于 2023-1-10 15:33
不好意思，刚才没核对。
代码已更新。

感谢老铁分享，是我要的结果！谢谢！谢谢！

LIUZHU

lpflbc 发表于 2023-1-10 15:31
我用的是excel,能运行吗？

额，不行，必须wps

lpflbc

fzxba 发表于 2023-1-10 15:48

感谢老铁分享，谢谢！谢谢！

mmwwdd

Sub test()
Dim cnn As Object
Dim rs As Object
Dim MySQL As String
Dim MyPath As String
Dim MyName As String
Dim ws As Worksheet
Dim wb As Workbook
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xls*")
  cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
Do While MyName <> ""
  If MyName <> "汇总.xls" Then
  MySQL = "select * from [excel 12.0;database=" & MyPath & MyName & "].[中学$]"
  rs.Open MySQL, cnn, 1, 3
    With Sheets("中学")
      r = .Cells(.Rows.Count, 1).End(3).Row
      .Range("A" & r).CopyFromRecordset rs
    End With
  rs.Close
End If
MyName = Dir
Loop
  
End Sub