1

当某些数据集包含 100 条记录时，我正在从一个站点提取数据，该站点一次将数据的呈现限制为 75 行
（为什么从来没有针对 ALL RECORDS 的选项）？

我可以安排我的循环来创建一个新工作表，但这会增加更多工作
，因为我必须单击多达 50 个工作表才能将工作表合并为一个。

到目前为止，我的脚本提取了数据，并设置了一个计数器来偏移
结果的位置，因此没有任何内容被覆盖。但是，在脚本完成后，我最终会得到
1500 个空白行，然后是数据集的最后几行。所以基本上我得到了 1000 个元素数据集的最后 75 行左右（一种情况下是 3 行）
不确定我在这里缺少什么。Querytables 是否总是将链接数据放在 $A$1 中？

编码：

Sub getHistoricalData()
Dim sheetname As String, url As String
Dim x_wsnames As Range
Dim ws As Worksheet, destinationRange As Range
Dim fillRange As Range, cell As Range, startCell As Range, endCell As Range
Dim operationalRange As Range, max As Integer
Dim last_objid As Integer, m As Integer
Dim startPage As Boolean, divider As String
On Error Resume Next

For Each x_wsnames In Sheets("data").Range("B2:B11")
'url = x_wsnames.Offset(0, 2).Value
max = x_wsnames.Offset(0, 2).Value
sheetname = x_wsnames.Value
'  Sheets.Add.Name = sheetname
Sheets(sheetname).Select
  Set ws = Sheets(sheetname)
  Select Case sheetname
    Case "A"
         position = "one"
    Case "B"
        position = "two"
    Case "C"
        position = "three"
    Case "D"
    position = "four"
  Case "E"
    position = "five"
  Case "F"
    position = "six"
   Case "G"
    position = "seven"
  Case "H"
    position = "eight"
  Case "I"
    position = "nine"
  Case "J"
    position = "ten"
End Select
Debug.Print "Processing cycleThroughWorksheets() " & sheetname

m = 0
For i = 1 To max
   url = "http://dataplace/search?category=type&dataType=historical&locations=ALL&d-112233-w=" & i & "&filter=" & divider

'Debug.Print i, url
If i = 1 Then
    Set destinationRange = Range("$A$1")
    Debug.Print destinationRange.Address
Else
    m = m + 75
    Set destinationRange = Range("$A$" & m)
    Debug.Print destinationRange.Address
End If
With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;" & url, destination:= _
    destinationRange)
    .Name = sheetname
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With
Next


Next 
End Sub
4

0 回答 0