Excel VBA在图纸中循环并调用子例程时出错

Question

当我在单独的工作表上运行子例程时，它运行得很好，但我在每个工作表上都遇到了很多问题。子程序是一个在线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

收集要在主循环中处理的工作表，并将其作为参数传递给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运行。您可能希望在创建连接时删除连接，或者只使用刷新方法来维护数据。