如何批量运行宏或者批量单击按钮

gallenfang

1. Sub rtian()
   
2. On Error Resume Next
   
3.     fp = ThisWorkbook.Path & ""
   
4.     mf = Dir(fp & "*.csv")
   
5.     Do While mf <> ""
   
6.         If Sheets(Split(mf, ".")(0)) Is Nothing Then
   
7.           Sheets.Add(after:=ActiveSheet).Name = Split(mf, ".")(0)
   
8.                  With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fp & mf, Destination:=Range("$A$1"))
   
9.                  .Name = Split(mf, ".")(0)
   
10.                  .FieldNames = True
    
11.                  .TextFileCommaDelimiter = True
    
12.                  .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    
13.                  .Refresh BackgroundQuery:=False
    
14.              End With
    
15.          End If
    
16.         mf = Dir
    
17.     Loop
    
18. End Sub

复制代码

1. Option Explicit
   
2. 
   
3. Sub czeroone()
   
4. Dim wsSum As Worksheet
   
5. Dim ws As Worksheet
   
6. Dim i As Integer
   
7. 
   
8. Set wsSum = Worksheets("C01")
   
9. wsSum.Range("a3:c" & wsSum.Cells(Rows.Count, 1).End(3).Row).Clear
   
10. i = 3
    
11. Application.ScreenUpdating = False
    
12. For Each ws In Worksheets
    
13.     If ws.Name <> wsSum.Name And IsDate(ws.Name) Then
    
14.         wsSum.Cells(i, 1) = ws.Name
    
15.         wsSum.Cells(i, 2) = Format(ws.Name, "yyyy/mm/dd")
    
16.         wsSum.Cells(i, 3) = WeekdayName(Weekday(Format(ws.Name, "yyyy/mm/dd"), vbMonday), False, vbMonday)
    
17.         i = i + 1
    
18.     End If
    
19. Next
    
20. Application.ScreenUpdating = True
    
21. End Sub

复制代码

我想把这两个宏结合成一个宏，然后第一个宏先运行，运行完了再运行第二个宏。如果可以的话，应该把代码合在一起？另外的话，类似第二个宏的还有很多个，例如，第三个，第四个宏是类似第二个宏的，我要实现的是要那么多宏一起运行。

如果这些宏的代码不能放在一起的话，能不能编写一个程序运行所有的宏？但是前提是，第一个宏必须是第一步运行的。

如果上面两个方法都不行的话，能不能把每个宏都设置一个按钮，然后编写一个程序，单击所有的按钮

02761752696

第一个宏最后加一句
Call 第二个宏名
.....................

02761752696

或者  这样

1. Sub 自动运行()
   
2. Call 第一个宏名
   
3. Call 第二个宏名
   
4. Call 第三个宏名
   
5. .....
   
6. End Sub

复制代码

gallenfang

02761752696 发表于 2016-5-16 17:08
第一个宏最后加一句
Call 第二个宏名
.....................

1. Sub rtian()
   
2. On Error Resume Next
   
3.     fp = ThisWorkbook.Path & ""
   
4.     mf = Dir(fp & "*.csv")
   
5.     Do While mf <> ""
   
6.         If Sheets(Split(mf, ".")(0)) Is Nothing Then
   
7.           Sheets.Add(after:=ActiveSheet).Name = Split(mf, ".")(0)
   
8.                  With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fp & mf, Destination:=Range("$A$1"))
   
9.                  .Name = Split(mf, ".")(0)
   
10.                  .FieldNames = True
    
11.                  .TextFileCommaDelimiter = True
    
12.                  .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    
13.                  .Refresh BackgroundQuery:=False
    
14.              End With
    
15.          End If
    
16.         mf = Dir
    
17.     Loop
    
18. End Sub
    
19. Call czeroone()
    
20. Option Explicit
    
21. 
    
22. Sub czeroone()
    
23. Dim wsSum As Worksheet
    
24. Dim ws As Worksheet
    
25. Dim i As Integer
    
26. 
    
27. Set wsSum = Worksheets("C01")
    
28. wsSum.Range("a3:c" & wsSum.Cells(Rows.Count, 1).End(3).Row).Clear
    
29. i = 3
    
30. Application.ScreenUpdating = False
    
31. For Each ws In Worksheets
    
32.     If ws.Name <> wsSum.Name And IsDate(ws.Name) Then
    
33.         wsSum.Cells(i, 1) = ws.Name
    
34.         wsSum.Cells(i, 2) = Format(ws.Name, "yyyy/mm/dd")
    
35.         wsSum.Cells(i, 3) = WeekdayName(Weekday(Format(ws.Name, "yyyy/mm/dd"), vbMonday), False, vbMonday)
    
36.         i = i + 1
    
37.     End If
    
38. Next
    
39. Application.ScreenUpdating = True
    
40. End Sub

复制代码

这样吗？好像不行哦

乐乐2006201506

修改了红色代码部分，你试试。

Sub rtian()
On Error Resume Next
    fp = ThisWorkbook.Path & "\"
    mf = Dir(fp & "*.csv")
    Do While mf <> ""
        If Sheets(Split(mf, ".")(0)) Is Nothing Then
          Sheets.Add(after:=ActiveSheet).Name = Split(mf, ".")(0)
                 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fp & mf, Destination:=Range("$A$1"))
                 .Name = Split(mf, ".")(0)
                 .FieldNames = True
                 .TextFileCommaDelimiter = True
                 .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                 .Refresh BackgroundQuery:=False
             End With
         End If
        mf = Dir
    Loop
   Call czeroone()
End Sub

Option Explicit

Sub czeroone()
Dim wsSum As Worksheet
Dim ws As Worksheet
Dim i As Integer

Set wsSum = Worksheets("C01")
wsSum.Range("a3:c" & wsSum.Cells(Rows.Count, 1).End(3).Row).Clear
i = 3
Application.ScreenUpdating = False
For Each ws In Worksheets
    If ws.Name <> wsSum.Name And IsDate(ws.Name) Then
        wsSum.Cells(i, 1) = ws.Name
        wsSum.Cells(i, 2) = Format(ws.Name, "yyyy/mm/dd")
        wsSum.Cells(i, 3) = WeekdayName(Weekday(Format(ws.Name, "yyyy/mm/dd"), vbMonday), False, vbMonday)
        i = i + 1
    End If
Next
Application.ScreenUpdating = True
End Sub

乐乐2006201506

这样应该就可以了，如果还不可以，建议上传附件。
Sub rtian()
On Error Resume Next
    fp = ThisWorkbook.Path & "\"
    mf = Dir(fp & "*.csv")
    Do While mf <> ""
        If Sheets(Split(mf, ".")(0)) Is Nothing Then
          Sheets.Add(after:=ActiveSheet).Name = Split(mf, ".")(0)
                 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fp & mf, Destination:=Range("$A$1"))
                 .Name = Split(mf, ".")(0)
                 .FieldNames = True
                 .TextFileCommaDelimiter = True
                 .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                 .Refresh BackgroundQuery:=False
             End With
         End If
        mf = Dir
    Loop
    Call czeroone
End Sub

Sub czeroone()
Dim wsSum As Worksheet
Dim ws As Worksheet
Dim i As Integer

Set wsSum = Worksheets("C01")
wsSum.Range("a3:c" & wsSum.Cells(Rows.Count, 1).End(3).Row).Clear
i = 3
Application.ScreenUpdating = False
For Each ws In Worksheets
    If ws.Name <> wsSum.Name And IsDate(ws.Name) Then
        wsSum.Cells(i, 1) = ws.Name
        wsSum.Cells(i, 2) = Format(ws.Name, "yyyy/mm/dd")
        wsSum.Cells(i, 3) = WeekdayName(Weekday(Format(ws.Name, "yyyy/mm/dd"), vbMonday), False, vbMonday)
        i = i + 1
    End If
Next
Application.ScreenUpdating = True
End Sub

02761752696

gallenfang 发表于 2016-5-16 18:42
这样吗？好像不行哦

加错位置了，在End Sub前面加,或者按下面那个自动运行的

02761752696

gallenfang 发表于 2016-5-16 18:42
这样吗？好像不行哦

还有你的Do   Loop结束才能继续后面的,不然就会一直l循环