Excel VBA无法循环查看表单并调用子例程

当我在单独的工作表上运行它时，我的子程序工作正常，但是我在处理每个工作表时遇到了很多问题。 子程序是一个在线CSV数据库的简单查询，但它只在第一张纸上执行25次。 无法弄清楚为什么这是我的生活。

我可以通过这个循环做计算，但是不能让它在每张纸上运行一个子程序。

Sub Datacollection() Dim ws As Worksheet For Each ws In Worksheets ws.Application.Run "Gethistory" Next ws End Sub Sub Gethistory() Dim Target As Variant Dim Name As Variant ' Set Target = Range("B1") Set Name = Range("B2") With ActiveSheet.QueryTables.Add(Connection:= _ "Text;" & Target, _ Destination:=Range("$A$3")) .Name = Name .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub 

Answer 1

收集要在主循环中处理的工作表，并将其作为parameter passing给getHistory子。

 Option Explicit Sub dataCollection() Dim w As Long For w = 1 To Worksheets.Count getHistory Worksheets(w) Next w End Sub Sub getHistory(ws As Worksheet) Dim trgt As Range, nm As Range With ws Set trgt = .Range("B1") Set nm = .Range("B2") With .QueryTables.Add(Connection:= _ "Text;" & trgt.Value, _ Destination:=.Range("$A$3")) .Name = nm.Value .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End With End Sub 

如果你反复这样做，最终会产生许多可能干扰一般工作簿效率以及将来getHistory运行的连接。 您可能希望在创build连接时删除连接，或者只使用刷新方法来维护数据。