[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『webクエリで複数ページからデータを抽出したい。』（はお）
初めまして。
現在、大学での研究用に準備段階としてwebからデータを抽出しようとしています。
Excelにほとんど触れてこなかった為、マクロを組む段階で躓いております。
以下簡単にですが現在の状況をまとめます。
出来ること
・手動でwebクエリからwebのページへ飛び、必要なデータを選択、sheetに書き出す。
・下記のようなマクロを使用し特定の1ページから特定テーブルのデータを抽出する。※参照サイトのものを引用いたしましたのでこの内容についてもわからない点はあるかもしれません。
～ゆーあーるえるサイトからテーブル10のデータをA1に抽出と認識しております～
Sub Macro1()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;ゆーあるえる" _
, Destination:=Range("A1"))
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = False
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.Refresh BackgroundQuery:=False
End With
End Sub
ここまでを前提としていただけると幸いです。
ではできないことですが
・複数サイトからデータを抽出
先ほどゆーあーるえるとさせていただきましたが実際には
h～～～t=1&～date=2019-03-27
のように日付ごとのデータ（data=〇〇〇〇-〇〇-〇〇）、そしてシリアル(t=〇)
となっております
過去一年分365日の、そしてシリアル1～10までのデータを抽出したいのですがここでギブアップしました。
様々なサイトや過去ログを拝見しましたが古い記事や微妙にやりたいことが違うため質問させていただきました。
本来であれば抽出したデータを種類別や曜日別で管理したいのですが、とりあえずデータの抽出のやり方をご教授願えませんでしょうか。
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
Dim mon As Integer, day As Integer
mon = 1 '1月
For day = 1 To 31 '1日から31日まで
'31日までない日の処理
If (mon = 4 Or 6 Or 9 Or 11) And day = 31 Then
Exit For
ElseIf mon = 2 And day = 29 Then Exit For
Else
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;ht..........date=2019-("&mon&")-("day")" _
, Destination:=Range("A1"))
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = False
.WebSelectionType = xlSpecifiedTables '選択型
.WebFormatting = xlWebFormattingNone
.WebTables = "10" 'tableの選択
.Refresh BackgroundQuery:=False
End With
End If
Next day
End Sub
現在の進行状況です。
ＵＲＬの中に変数を組み込んでforで日付分回してみようと思ったのですが、構文エラーになります。
いまは実験段階としてunitはデフォルトでmonも回さず1月分を1日から31日まで抽出しようというものです。
...2019-1-1
のままで試した際はエラーは起こらず処理時間的にも31回ループしていたことを確認しています。
(おそらく同じシートの同じ場所に何度も出力されていたのでそこも修正が必要ですが...＞＜)
（はお） 2019/03/29(金) 20:55
こんばんは ＾＾ http://officetanaka.net/excel/vba/tips/tips90.htm など参考になるのではないでしょうか。 （隠居じーさん） 2019/03/29(金) 21:47
日付のところはこんなコードが参考になりませんか？
Sub test()
Dim d As Date
Dim d1 As Date, d2 As Date
d1 = DateSerial(2019, 1, 1)
d2 = DateSerial(2019, 2, 1)
For d = d1 To d2 - 1
Debug.Print Format(d, "yyyy-mm-dd")
Next
End Sub
（γ） 2019/03/29(金) 21:57
"& mon &"
スペースをあけてみたらうまくいきました！
あと単純にdayのほうに&&をつけ忘れていました
気を付けます。
＞＞γさん
なるほど！！
日付型にもforを回すことができるのですね！！
これを利用すれば不細工なforとifを用いたソースを使わなくて済みそうです！
今の問題を解決でき次第改変してみたいと思います！
現在forを使ってURL内の日付けを変更して複数のページからデータを抜き出すことに成功しました。
続いて、抜き取ったデータを見やすく整理しながらシートに保存していく部分を作成しています。
品名 ＡＡＡ 価格 ＢＢＢ 品名 ＥＥＥ 価格 ＦＦＦ
コード ＣＣＣ 在庫 ＤＤＤ コード ＧＧＧ 在庫 ＨＨＨ
のように8個のマス目を使ってテーブル?でエクセル上に表示されています。
※初めてExcelを触っているので正式な名称ではありませんご了承ください。
これを
品名 価格 コード 在庫
ＡＡＡ ＢＢＢ ＣＣＣ ＤＤＤ
ＥＥＥ ＦＦＦ ＧＧＧ ＨＨＨ
として、日付順に上から羅列した状態で保存したいんですが、色々サイトを冒険してみても分からず・・・
シートを2枚作って1枚に直接データを落とし、それらをコピーしたうえでもう一枚のシートに並べ替えて張り付けていくイメージなのでしょうか？
皆様のお力をお貸しください。
（はお） 2019/03/29(金) 23:23
おはようございます ＾＾ 回答では有りませんが何かの足しにでも。もっとスマートな方法 がいろいろ有るとはおもいますが一案として、 Sheet1 がこのよ うなレイアウトだと仮定する。が前程です。
A B C D E F G H
1 品名 ＡＡＡ 価格 ＢＢＢ 品名 ＥＥＥ 価格 ＦＦＦ
2 コード ＣＣＣ 在庫 ＤＤＤ コード ＧＧＧ 在庫 ＨＨＨ
Option Explicit
Sub Sample()
Dim i As Long
Dim x As Long
Dim WF
Dim Rr As Range
Dim R As Range
Dim Buffer
Dim 品名()
Dim 価格()
Dim コード()
Dim 在庫()
Dim cnt(1 To 4) As Long
Set WF = WorksheetFunction
Worksheets("Sheet1").Copy
With ActiveSheet
Set Rr = .Range("A1").CurrentRegion
For Each R In Rr.Rows
For i = 1 To Rr.Columns.Count Step 2
Select Case R.Cells(i)
Case "品名"
ReDim Preserve 品名(cnt(1))
品名(cnt(1)) = R.Cells(i).Offset(, 1)
cnt(1) = cnt(1) + 1
Case "価格"
ReDim Preserve 価格(cnt(2))
価格(cnt(2)) = R.Cells(i).Offset(, 1)
cnt(2) = cnt(2) + 1
Case "コード"
ReDim Preserve コード(cnt(3))
コード(cnt(3)) = R.Cells(i).Offset(, 1)
cnt(3) = cnt(3) + 1
Case "在庫"
ReDim Preserve 在庫(cnt(4))
在庫(cnt(4)) = R.Cells(i).Offset(, 1)
cnt(4) = cnt(4) + 1
End Select
Next
Next
Buffer = Array(品名, 価格, コード, 在庫)
.UsedRange.Clear
.Cells(1).Resize(, 4) = Array("品名", "価格", "コード", "在庫")
For x = LBound(Buffer) To UBound(Buffer)
.Cells(2, x + 1).Resize(UBound(Buffer(x)) + 1, 1) = WF.Transpose(Buffer(x))
Next
End With
End Sub
（隠居じーさん） 2019/03/30(土) 06:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.