自动打开多个工作簿并触发其模块里的宏自动运行

zhaogang1960

lijian8003 发表于 2013-3-26 13:49
您好！谢谢给予的帮助，这代码运行流畅。实际运用中，出现一个问题，恳望老师继续给予帮助！
附件中， ...

在最后加一句Call CommandButton1_Click即可:
附件.rar (6.12 KB, 下载次数: 140)

2013-3-26 15:00 上传

点击文件名下载附件

lijian8003

zhaogang1960 发表于 2013-3-17 15:01
VBA没有多线程功能，只能逐个打开、运行程序了：

谢谢帮助！实际运用中，还有一个疑问，需要您的指导：
如果您写的“循环打开工作簿并运行它的宏”代码，存放在名为“汇总”的模块中，原先是运行该代码，逐个打开一个工作簿，运行宏代码，再关闭保存；现在能否在关闭保存前加入一个动作，即在每个工作簿关闭保存前，先提取该工作簿中名为“参数”的工作表中C1单元格的数值（该数值是该工作簿运行宏代码后，用另外的函数公式汇总得到的），提取的数值写入“汇总”工作簿的sheet1，第一个提取的数值写入A1单元格，第二个提取的数值写入B1单元格......？
恳望得到您的帮助！

zhaogang1960

lijian8003 发表于 2013-3-26 18:01
谢谢帮助！实际运用中，还有一个疑问，需要您的指导：
如果您写的“循环打开工作簿并运行它的宏”代码， ...

不知所云
请模拟效果说明

lijian8003

zhaogang1960 发表于 2013-3-17 17:35
用程序导入文本文件，再运行工作簿中的程序：

谢谢您的帮助！为了扩展运用您写的代码，我略作改动如下，但是有个问题一直无法解决。

这个问题是：
我欲多次循环打开指定工作簿，多次导入不同数据，并运行它的宏，比如循环打开以01-50命名的50个工作簿，导入D:\数据1.txt，运行它们的宏（宏名统一为test1)，之后再打开以汇总1命名的工作簿，并运行宏test2；
然后，第二次循环打开以01-50命名的50个工作簿，导入D:\数据2.txt，运行它们的宏，之后再运行以汇总2命名的工作簿；
接着，第三次....第63次循环打开以01-50命名的50个工作簿，导入D:\数据63.txt，运行它们的宏，之后再运行以汇总63命名的工作簿；
这样的思路如何实现？恳望再次得到您的帮助！

另：需要导入的数据，如果与需要循环运行的excel存放在同一个文件夹里，VBA代码里的数据路径怎样修改？

Sub 循环打开工作簿并运行它的宏()
    Dim p$, f$, s$(), srr&(), i&, j&, a
    Application.ScreenUpdating = False
    Open "D:\数据1.txt" For Input As #1
    s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    Close #1
    ReDim srr(UBound(s), 63)
    For i = 0 To UBound(s)
        a = Split(s(i), " ")
        For j = 0 To 63
            srr(i, j) = a(j)
        Next
    Next
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls*")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            With Workbooks.Open(p & f, 0)
                .Sheets("数据").[a1].Resize(i, 64) = srr
                Application.Run "'" & f & "'!模块1.test1"
                .Close False '关闭不保存
            End With
        End If
        f = Dir
    Loop
    Application.ScreenUpdating = True
    End Sub

lijian8003

zhaogang1960 发表于 2013-3-17 15:01
VBA没有多线程功能，只能逐个打开、运行程序了：

您写的下述代码用于循环打开工作簿。现在，欲只循环打开具有“模版_001”、“模版_002”......这样名称的工作簿，下述代码加红处如何修改？恳望再次得到您的帮助！

Sub 循环打开工作簿并运行它的宏()
    Dim p$, f$, s$(), srr&(), i&, j&, a
    Application.ScreenUpdating = False
    Open "c:\运行\01.txt" For Input As #1
    s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    Close #1
    ReDim srr(UBound(s), 1)
    For i = 0 To UBound(s)
        a = Split(s(i), " ")
        For j = 0 To 1
            srr(i, j) = a(j)
        Next
    Next
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xlsm")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            With Workbooks.Open(p & f, 0)
                .Sheets("数据").[a1].Resize(i, 2) = srr
                Application.Run "'" & f & "'!模块1.宏1"
                .Close False '关闭不保存
            End With
        End If
        f = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

zhaogang1960

lijian8003 发表于 2013-6-5 18:26
您写的下述代码用于循环打开工作簿。现在，欲只循环打开具有“模版_001”、“模版_002”......这样名称的 ...

1. Sub 循环打开工作簿并运行它的宏()
   
2.     Dim p$, arr, f, s$(), srr&(), i&, j&, a
   
3.     Application.ScreenUpdating = False
   
4.     Open "c:\运行\01.txt" For Input As #1
   
5.     s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
   
6.     Close #1
   
7.     ReDim srr(UBound(s), 1)
   
8.     For i = 0 To UBound(s)
   
9.         a = Split(s(i), " ")
   
10.         For j = 0 To 1
    
11.             srr(i, j) = a(j)
    
12.         Next
    
13.     Next
    
14.     p = ThisWorkbook.Path & ""
    
15.     arr = Array("模版_001", "模版_002")
    
16.     For i = LBound(arr) To UBound(arr)
    
17.         f = Dir(p & arr(i) & ".xls*")
    
18.         If f <> "" Then
    
19.             With Workbooks.Open(p & f, 0)
    
20.                 .Sheets("数据").[a1].Resize(i, 2) = srr
    
21.                 Application.Run "'" & f & "'!模块1.宏1"
    
22.                 .Close False '关闭不保存
    
23.             End With
    
24.         End If
    
25.     Next
    
26.     Application.ScreenUpdating = True
    
27. End Sub

复制代码

beetle1985

谢谢，收获颇多！！！！

janly

看起来很复杂的个暗觉

LMY123

批量打开工作薄，执行同一个宏程序

10307951261

留个记号，好使用