データの表示を一度に 75 行に制限するサイトからデータを取得していますが、一部のデータ セットには 100 レコードが含まれています
(すべてのレコードのオプションがないのはなぜですか)。
ループを調整して新しいシートを作成することもできますが
、シートを 1 つに結合するには最大 50 枚のシートをクリックする必要があるため、作業が増えます。
これまでのところ、スクリプトはデータを取得し、カウンターを設定して
結果の配置をオフセットし、何も上書きされないようにしました。ただし、スクリプトが完了すると
、あるケースでは 1500 行の空白行になり、その後データセットの最後の数行になります。したがって、基本的には、1000 個の要素データセットの最後の 75 行程度 (1 つのケースでは 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