运行VBAmacros以触发不同工作表中的macros

情况是这样的：我有40个工作表embedded相同的macros称为RetrieveNumbers 。 根据每个工作表中的各种参数，最终结果为40张将会有所不同。

要更新数字，我手动单击macrosbutton以检索40个工作表中的数字。 因此，我厌倦了。 为了简化testing，我只使用两张纸（Sheet1，Sheet2）来testing是否通过点击一个名为RunAll的macros来运行两个macros。

当然，我失败了。

我努力了 ：

1. application.run

2. 呼叫

我尝试了两种情况：

1. 我在RunAll窗口和Sheet1工作表上的其他屏幕上按 F5。 它运行完美，但它在Sheet1中运行两次，而不是去到Sheet2。

2. 我按了RunAll窗口中的F5和RunAll工作表上的另一个屏幕。 点击后，我回去看看有没有数字。 当然，没有。

我以为macros会去Sheet2，然后运行macrosRetrivenumbers2。 但事实并非如此。 它留在当前的工作表中。 请给我一些关于如何运行我想要的下一张床单的指导。 让我知道是否需要在这个问题上进一步澄清。

macros检索数字
（由于Macro RetrieveNumbers2与RetrieveNumbers1相同，所以我不包含它）

Sub RetrieveNumbers1() Dim NumberFiles As Integer, FilesVisited As Integer, RowNumber As Integer Let NumberFiles = ActiveSheet.Cells("2", "A").Value Let FilesVisited = 0 'start from 0 Let RowNumber = 4 'start from column B If NumberFiles > 30 Then MsgBox "Don't try to retrieve numbers from more than 30 files at a time!" Else For FilesVisited = 1 To NumberFiles 'Open files, get path, file, tab name and cells Dim PathFileOpen As String, NameFileOpen As String, NameTab As String, FileDir As String Let PathFileOpen = ActiveSheet.Cells(RowNumber, "A").Text Let NameFileOpen = ActiveSheet.Cells(RowNumber, "B").Text Let NameTab = ActiveSheet.Cells(RowNumber, "C").Text Dim N As Integer, Cell As String, NumberYears As String, FullLink As String NumberYears = ActiveSheet.Cells("2", "B").Value For N = 4 To NumberYears + 3 Cell = ActiveSheet.Cells(RowNumber, N).Text FullLink = "(=)'" & PathFileOpen & "\[" & NameFileOpen & ".xlsm]" & NameTab & "'!" & Cell ActiveSheet.Cells(RowNumber, N + 13).Value = FullLink Next N RowNumber = RowNumber + 1 Next FilesVisited End If ActiveSheet.Range("A1").CurrentRegion.Replace What:="(=)", Replacement:="=", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False End Sub 

macrosRunAll

 Sub runall() Call Sheet1.RetrieveNumbers1 Call Sheet2.RetrieveNumbers2 End Sub 

清除文件 工作文件示例的示例

Answer 1

你的代码有相当多的错误。 正如@PGCodeRider在他的回答中所说的那样 – 在所有工作表上都有一个程序。 他的代码在程序中有循环。

此代码使用一个单独的过程来循环显示工作表，并将工作表的引用传递给RetrieveNumbers过程。
我用wrkSht （引用RunAllSheets过程通过的表单）replace了ActiveSheet所有实例（对ActiveSheet的引用）。
所有Dims已经被移动到代码的顶部，因为它们只需要声明一次而不是每个循环（您可以更改variables在每个循环中保留的值，但不需要再声明它们）。

 Sub RunOnAllSheets() Dim wrkSht As Worksheet For Each wrkSht In ThisWorkbook.Worksheets Select Case wrkSht.Name Case "Sheet1", "Sheet2" 'Do nothing. Case Else 'For all other sheets execute the RetrieveNumbers procedure 'and pass the wrkSht variable to it. RetrieveNumbers wrkSht End Select Next wrkSht End Sub Sub RetrieveNumbers(wrkSht As Worksheet) Dim NumberFiles As Integer, FilesVisited As Integer, RowNumber As Integer 'You only need to declare these once. Dim PathFileOpen As String, NameFileOpen As String, NameTab As String, FileDir As String Dim N As Integer, Cell As String, NumberYears As String, FullLink As String 'No need to use 'LET' it's a left-over from the days of Sinclair Basic 'ok, maybe not.... but it's an old way of doing it. NumberFiles = wrkSht.Cells("2", "A").Value FilesVisited = 0 'start from 0 RowNumber = 4 'start from column B If NumberFiles > 30 Then MsgBox "Don't try to retrieve numbers from more than 30 files at a time!" Else For FilesVisited = 1 To NumberFiles 'Open files, get path, file, tab name and cells PathFileOpen = wrkSht.Cells(RowNumber, "A").Text NameFileOpen = wrkSht.Cells(RowNumber, "B").Text NameTab = wrkSht.Cells(RowNumber, "C").Text NumberYears = wrkSht.Cells("2", "B").Value For N = 4 To NumberYears + 3 Cell = wrkSht.Cells(RowNumber, N).Text FullLink = "(=)'" & PathFileOpen & "\[" & NameFileOpen & ".xlsm]" & NameTab & "'!" & Cell wrkSht.Cells(RowNumber, N + 13).Value = FullLink Next N RowNumber = RowNumber + 1 Next FilesVisited End If wrkSht.Range("A1").CurrentRegion.Replace What:="(=)", Replacement:="=", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False End Sub 

---

编辑后，接受为答案：

此方法只引用表单两次。 一次拉链接信息，再一次把最后的公式放回到工作表上。

 Sub RunOnAllSheets() Dim wrkSht As Worksheet For Each wrkSht In ThisWorkbook.Worksheets 'Have removed the Select Case statement so it looks at all sheets. RetrieveNumbers wrkSht Next wrkSht End Sub Sub RetrieveNumbers(wrkSht As Worksheet) Dim NumberFiles As Long, FilesVisited As Long Dim vCellValues As Variant, vLinkValues() As Variant Dim FullPath As String Dim x As Long With wrkSht 'Get the last row number that contains data in column N. NumberFiles = .Cells(.Rows.Count, "N").End(xlUp).Row If NumberFiles - 3 > 30 Then MsgBox "Don't try to retrieve numbers from more than 30 files at a time!" Else 'Pass the cell values to an array. vCellValues = .Range("A4:C4") 'Create the full path excluding the cell reference. FullPath = "='" & vCellValues(1, 1) & "[" & vCellValues(1, 2) & "]" & vCellValues(1, 3) & "'!" 'Create an array of full path & cell references. ReDim vLinkValues(1 To NumberFiles - 3) 'Set the array size. For x = 1 To NumberFiles - 3 vLinkValues(x) = FullPath & .Cells(x + 3, "N") Next x 'Paste the array back to the sheet. .Range(.Cells(4, "N"), .Cells(NumberFiles, "N")).Formula = vLinkValues End If End With End Sub 

注意：这里假定你的path在单元格A4：C4中，如代码vCellValues = .Range("A4:C4") （我不确定这是否是这种情况）。
如果您的path在每行匹配的单元格值，您将需要：

• 将vCellValues = .Range("A4:C4")更改为
  vCellValues = .Range(.Cells(4, 1), .Cells(NumberFiles, 3))
• 删除FullPath='....行。
• 将vLinkValues(x) = FullPath & .Cells(x + 3, "N")更改为
  vLinkValues(x) = "='" & vCellValues(x, 1) & "[" & vCellValues(x, 2) & "]" & vCellValues(x, 3) & "'!" & .Cells(x + 3, "N")

Answer 2

尝试在工作簿中的所有工作表中循环运行？ 还要确保你在你的vba编辑器中的模块中运行这个。 不是你的表单代码。

 Sub RetrieveNumbers1() Dim WS As Worksheet 'loop that goes through all sheets in your workbook. Where you used to have 'activesheet, I changed to ws For Each WS In ThisWorkbook.Sheets Dim NumberFiles As Integer, FilesVisited As Integer, RowNumber As Integer Let NumberFiles = WS.Cells("2", "A").Value Let FilesVisited = 0 'start from 0 Let RowNumber = 4 'start from column B If NumberFiles > 30 Then MsgBox "Don't try to retrieve numbers from more than 30 files at a time!" Else For FilesVisited = 1 To NumberFiles 'Open files, get path, file, tab name and cells Dim PathFileOpen As String, NameFileOpen As String, NameTab As String, FileDir As String Let PathFileOpen = WS.Cells(RowNumber, "A").Text Let NameFileOpen = WS.Cells(RowNumber, "B").Text Let NameTab = WS.Cells(RowNumber, "C").Text Dim N As Integer, Cell As String, NumberYears As String, FullLink As String NumberYears = WS.Cells("2", "B").Value For N = 4 To NumberYears + 3 Cell = WS.Cells(RowNumber, N).Text FullLink = "(=)'" & PathFileOpen & "\[" & NameFileOpen & ".xlsm]" & NameTab & "'!" & Cell WS.Cells(RowNumber, N + 13).Value = FullLink Next N RowNumber = RowNumber + 1 Next FilesVisited End If ws.Range("A1").CurrentRegion.Replace What:="(=)", Replacement:="=", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 'restarts on the next ws Next WS End Sub