关于 表格 合并的 求助

学习学习vba

重新上传了 附件：： 合并help.rar (9.53 KB, 下载次数: 16)

2017-11-23 21:40 上传

点击文件名下载附件

问题是这样的，

在 合并help.xls 里，我执行vba代码后，就能实现：
把 test文件夹下的表格 合并到 合并help.xls 里,
并且 原先表格的名字为 合并help.xls 里的每一个Sheet名

test文件夹下的表格不定。。。

这样的代码要如何写呢？

请教各位老师

ahnyt

合并工作簿下的那个表

lsc900707

你的附件里既没有test文件夹，又没有丁点儿数据！

学习学习vba

lsc900707 发表于 2017-11-23 21:33
你的附件里既没有test文件夹，又没有丁点儿数据！

版主好。。

是忘记放数据了。
原先的表数据不多。每个表格30行数据这样。

学习学习vba

各位老师 。。已重新上传了附件

学习学习vba

ahnyt 发表于 2017-11-23 21:30
合并工作簿下的那个表

老师好 。。已重新上传了附件

学习学习vba

lsc900707 发表于 2017-11-23 21:33
你的附件里既没有test文件夹，又没有丁点儿数据！

版主好 。。已重新上传了附件

abc123281

最好上传原始数据，你要干什么老师们不清楚

一把小刀闯天下

'满意来朵小花哈
Option Explicit

Sub test()
  Dim filename(), i, wb, sht, t, arr, flag As Boolean
  If Not getfilename(filename, ThisWorkbook.Path, ".xls") Then Exit Sub
  For i = 1 To UBound(filename)
    If InStr(filename(i), "合并help") = 0 Then
      t = Split(filename(i), "\")
      t = Split(t(UBound(t)), ".")(0)
      Set wb = GetObject(filename(i))
      arr = wb.ActiveSheet.UsedRange
      wb.Close
      For Each sht In Sheets
        If sht.Name = t Then flag = True: Exit For
      Next
      If flag Then
        flag = False
      Else
        Sheets.Add
        ActiveSheet.Name = t
      End If
      Sheets(sht.Name).[a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End If
  Next
End Sub

Function getfilename(filename, pth, mark) As Boolean
  Dim f, n
  If Right(pth, 1) <> "\" Then pth = pth & "\"
  f = Dir(pth & "*.*")
  Do While Len(f) > 0
    If LCase(Right(f, Len(mark))) = LCase(mark) Then
      n = n + 1: ReDim Preserve filename(1 To n)
      filename(n) = pth & f
    End If
    f = Dir
  Loop
  If n > 0 Then getfilename = True
End Function

一把小刀闯天下

学习学习vba 发表于 2017-11-23 21:42
版主好 。。已重新上传了附件

有2行修改一下哈：
If Not getfilename(filename, ThisWorkbook.Path, ".xls") Then Exit Sub   改为：
If Not getfilename(filename, ThisWorkbook.Path & "\test", ".xls") Then Exit Sub

If InStr(filename(i), "合并help") = 0 Then  改为：
If LCase(filename(i)) <> LCase(ThisWorkbook.FullName) Then


因为我不知道你把条件改了