多表合并问题

外块300 · 发表于 2020-5-28 15:51

hailex 发表于 2020-5-28 14:19
大哥我试了下,没什么效果

之前没有看你的表格，以为合并表格到一起就可以了，只要修改几行就可以直接提取数据了。

cui26896 · 发表于 2020-5-28 16:06

按行排序没有解决，但看了一下发出来的代码，好象没有我的简洁，就发一下吧。
Option Explicit
Sub test()
Dim arr, brr, f, p, i&, j&, k
  p = ThisWorkbook.Path & "\"
  f = Dir(p & "*.xlsx")
  Sheets(1).Range("d1").Resize(12, 4).ClearContents
  Application.ScreenUpdating = False
Do While Len(f)
   If f <> ThisWorkbook.Name Then
      With GetObject(p & f)
      brr = .Sheets("答题卡").Range("c1:c" & .Sheets("答题卡").UsedRange.Rows.Count)
      .Close 0
      End With
   End If
   k = k + 1
   With ThisWorkbook.Sheets(1)
      .Activate
      .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(UBound(brr), 1) = brr
   End With
f = Dir
Loop
  Application.ScreenUpdating = True
End Sub

cui26896 · 发表于 2020-5-28 16:07

发代码又要审核，先发附件

测试.zip (46.31 KB, 下载次数: 8)

cui26896 · 发表于 2020-5-28 16:36

上次的没有解决按行排序，再发补充了按行排序

成绩合并表.zip (48.37 KB, 下载次数: 11)

hailex · 发表于 2020-5-28 22:47

感谢大家的热心帮助，努力消化大神们的代码中……

		自动登录	找回密码
密码			免费注册

[求助] 多表合并问题