通宵两宿没干完，高手帮个忙

thtfzhaobo

你随便搜个合并的帖子,基本可以完成你的需求,有包含汇总的,即使不包含也很容易了

蓝桥玄霜

Sub pldrwb0531()
'汇总表.xls
'导入指定文件的数据
    Dim myFs As FileSearch
    Dim myPath As String, Filename$
    Dim i As Long, n As Long
    Dim Sht1 As Worksheet, sh As Worksheet
    Dim aa, nm$, nm1$, m, arr, r1, col1%
Application.ScreenUpdating = False
Set Sht1 = ActiveSheet
    Set myFs = Application.FileSearch
    myPath = ThisWorkbook.Path
    With myFs
        .NewSearch
        .LookIn = myPath
        .FileType = msoFileTypeNoteItem
        .Filename = "*.xls"
        If .Execute(SortBy:=msoSortByFileName) > 0 Then
            n = .FoundFiles.Count
            ReDim myfile(1 To n) As String
            For i = 1 To n
                myfile(i) = .FoundFiles(i)
                Filename = myfile(i)
                aa = InStrRev(Filename, "\")
                nm = Right(Filename, Len(Filename) - aa)
                nm1 = Left(nm, Len(nm) - 4)
                If nm1 <> "汇总表" Then
                    Workbooks.Open myfile(i)
                    Dim wb As Workbook
                    Set wb = ActiveWorkbook
                    m = [a65536].End(xlUp).Row
                    arr = Range(Cells(3, 3), Cells(m, 3))
                    Sht1.Activate
                    Set r1 = Rows(2).Find(nm)
                    col1 = r1.Column
                    Cells(3, col1).Resize(UBound(arr), 1) = arr
                    wb.Close savechanges:=False
                    Set wb = Nothing
                End If
            Next
        Else
            MsgBox "该文件夹里没有任何文件"
        End If
    End With
    [a1].Select
   
    Set myFs = Nothing
Application.ScreenUpdating = True
End Sub

lbwrong

12 楼的兄弟  你真是好样的，我想请您 帮我个忙再  我希望实现
从单元格  C2  开始 到   ZZ2 的文件名能自动获取  不是用手一个一个的复制粘贴
还有就是 取来的数值  最好有引用地址  就像  ='C:\help\help\[福田宾馆.xls]Sheet1'!$C$15 这样子的
可以做到吗？

lbwrong

数值显示  ='C:\help\help\[福田宾馆.xls]Sheet1'!$C$15   同时也  方便其它人  对取来过的 数值进行校验

现在不能实现自动获取 文件名字

蓝桥玄霜

Sub pldrwb0531()
'汇总表.xls
'导入指定文件的数据
    Dim myFs As FileSearch
    Dim myPath As String, Filename$
    Dim i As Long, n As Long
    Dim Sht1 As Worksheet, sh As Worksheet
    Dim aa, nm$, nm1$, m, arr, r1, col1%
Application.ScreenUpdating = False
Set Sht1 = ActiveSheet
    Set myFs = Application.FileSearch
    myPath = ThisWorkbook.Path
    With myFs
        .NewSearch
        .LookIn = myPath
        .FileType = msoFileTypeNoteItem
        .Filename = "*.xls"
        If .Execute(SortBy:=msoSortByFileName) > 0 Then
            n = .FoundFiles.Count
            col1 = 2
            ReDim myfile(1 To n) As String
            For i = 1 To n
                myfile(i) = .FoundFiles(i)
                Filename = myfile(i)
                aa = InStrRev(Filename, "\")
                nm = Right(Filename, Len(Filename) - aa)
                nm1 = Left(nm, Len(nm) - 4)
                If nm1 <> "汇总表" Then
                    Workbooks.Open myfile(i)
                    Dim wb As Workbook
                    Set wb = ActiveWorkbook
                    m = [a65536].End(xlUp).Row
                    arr = Range(Cells(3, 3), Cells(m, 3))
                    Sht1.Activate
                    col1 = col1 + 1
                    Cells(2, col1) = nm    '自动获取文件名
                    Cells(3, col1).Resize(UBound(arr), 1) = arr
                    wb.Close savechanges:=False
                    Set wb = Nothing
                End If
            Next
        Else
            MsgBox "该文件夹里没有任何文件"
        End If
    End With
    [a1].Select
   
    Set myFs = Nothing
Application.ScreenUpdating = True
End Sub
至于数值显示引用地址，会导致全是公式，速度会很慢，再说要复核校验一般是打印出来再查的，在电脑上切换来切换去的并不方便的。

lbwrong

兄弟 没事 慢也行  你帮帮我吧
我要显示地址  公式就公式 慢就慢  真的 我真的需要这个东西

帮帮我呗

lbwrong

兄弟你太强了 你编的这个解决了我工作当中的一大难点   我太感激你了
你是哪里人，我是辽宁的  你要是来昌图县 我得请请你 好好的

lbwrong

对了  兄弟  我的这个汇总工作 help 是做个例子
实际工作中需要对汇总的工作表进行选择  不一定是汇总 sheet1 这个工作表
这个需要怎样进行修改呢？ 我的每个 .xls 文件中都有十几个 工作表  一般全是中文名字
没有像 sheet1 这样的 都是  “装置性材料” “土方” 这样的，在 VBA要怎么修改呢？

thtfzhaobo

建议楼主一次把要求说清楚，该要比写麻烦，尤其是一遍一遍的改，不复杂的过程越说越复杂

lbwrong

其的问题一直都有提呀，数值显示公式
我不明白这个语句的含义，我只是想知道 这对一个文件内多个
工作表是汇总哪个工作表