マクロのWEBデータの取り込み
下のように書いてマクロを実行したのですが(EXCEL2003)
Sheet1のA1からDP1000のデータをクリアにしてから
URLのデータを取り込んで
D列の最終行の値を
Sheet2のA列の日付+1行に書き込みたいのですが
Sheet1のA1からDP1000のデータをクリアにする前に
D列の最終行の値を
Sheet2のA列の日付+1行に書き込んでしまいます。
あとConst Col = 4の部分が
同じ範囲内で宣言が重複しています。
とエラーになります。
どこが悪いのかがわかりません。
よろしくお願いします。
Sub 抽出()
Worksheets("Sheet1").Range("A1:DP1000").Value = ""
nen = InputBox("読み込む年度、西暦4桁(半角)読み込む月(半角)を入力")
tuki = InputBox("読み込む日(半角)を入力")
strUrl= "URL;http://○○○○★★★★DATFR=#01&DATTO=#$&MSCD=1431&BMCD=30&MENU_ID=2&MENU_ID1=2"
strnen = Mid(Str(nen), 2)
strtuki = Mid(Str(tuki), 2)
strUrl = Replace(Replace(strUrl, "$", strtuki), "#", strnen)
strName = Replace(Replace(strName, "$", strtuki), "#", strnen)
With Worksheets("野菜").QueryTables.Add(Connection:=strUrl, Destination:=Worksheets("Sheet1").Range("A1"))
.Name = strtuki
.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:=True
End With
Const Col = 4
Dim Rw As Long
With Sheets("Sheet1")
Rw = .Cells(Rows.Count, Col).End(xlUp).Row
Sheets("Sheet2").Range("A" & tuki + 1 & ":A" & tuki + 1).Value = _
.Range(.Cells(Rw, 4), .Cells(Rw, 4)).Value
End With
strUrl= "URL;http://○○○○■■■■DATFR=#01&DATTO=#$&MSCD=1431&BMCD=30&MENU_ID=2&MENU_ID1=2"
strnen = Mid(Str(nen), 2)
strtuki = Mid(Str(tuki), 2)
strUrl = Replace(Replace(strUrl, "$", strtuki), "#", strnen)
strName = Replace(Replace(strName, "$", strtuki), "#", strnen)
With Worksheets("Sheet3").QueryTables.Add(Connection:=strUrl, Destination:=Worksheets("Sheet3").Range("A1"))
.Name = strtuki
.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:=True
End With
Const Col = 4
Dim Rw As Long
With Sheets("Sheet3")
Rw = .Cells(Rows.Count, Col).End(xlUp).Row
Sheets("Sheet4").Range("A" & tuki + 1 & ":A" & tuki + 1).Value = _
.Range(.Cells(Rw, 4), .Cells(Rw, 4)).Value
End With
End Sub
お礼
アドバイス有難うございました、 If Range("A1") <> "順位" And Range("A1") <> "コード" Then ws.QueryTables(1).Refresh BackgroundQuery:=False End If 教えて頂いた方法を参考に解決しました。 お世話様でした。