これからの季節に親子でハイキング! >>

NPB(日本プロ野球機構)のデータベースからExcelにとりこむマクロを実行しているのですが

.Refresh BackgroundQuery:=False
というところで、処理が重くなって止まってしまいます。
何か解決策はあるでしょうか?


url = "URL;http://bis.npb.or.jp/2017/stats/idb1_[チーム名].html"
でURLを指定して
以下のようにしてクエリテーブルを取得

With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Range("B1"))
.RefreshStyle = xlInsertDeleteCells
.AdjustColumnWidth = False
'.WebSelectionType = xlSpecifiedTables
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
'.WebTables = 6 'webページから成績一覧を抜粋する行を指定している。6が都合がよい
.Refresh BackgroundQuery:=False
End With

とりこんだクエリをExcel内でコピー&ペースト

以上の処理をチーム名を変えて繰り返し実行しています。
1,2回目までは普通に動くのですが、数回繰り返すと、処理が重くなり途中で止まってしまいます。

A 回答 (2件)

こんにちは。


>QueryTableではない方法にぜひ取り組んでみたいのですが、、
逆に、こういう話の展開できることに、感謝します。難しいといって敬遠する方も多いようです。最初のスタートラインは、みんな同じです。

Webデータを取り込む方法....前段階

>https://tonari-it.com/vba-ie-list/ (いつも隣にIT)
ノウハウは、このままで良いのですが、今、取り込もうとしているサイトは、基本的なことを全部使えるところなのです。

>勉強の参考になるサイト等ご存知でしたら教えていただけますか。
私が参考にするのは、三流君(http://www.ken3.org/vba/) です。まともに読んでいられないというのが、大方の人の本音でしょうけれども、この作者が一つずつとりくんでいったことを、技術力も経験も乏しい私にとって、ここで自分自身が体験することでしか、納得する方法がありません。

みなさんは、よく https://www.vba-ie.net/ を参照しているとおっしゃっているようですが、私にはさっぱり役に立ちません。理由は、万能なテクニックなどは存在しないからです。

それと、法的な部分は少し頭に入れておいてください。場合によって、警察沙汰になり、冤罪事件がいくつも起きています。今回の場所は、もちろん、よほどの特殊な機械を用いない限り、法律に抵触することはありません。(威力業務妨害罪等)
https://qiita.com/nezuq/items/c5e827e1827e7cb29011
なお、私の調べた認識のレベルでは、Amazon は△、JRAや今回のnbp、教えて!gooは◯、モーグは×、ハロワ ×, ヤフオク ◯ というようになっています。×でも、これ(いつも隣に)は、スクレイピングという技術を使ってはいけないだけで、自動実行そのものにほぼ問題はありません。

次に、二種類の取得の仕方があります。DOM か、IEオブジェクトか、
それで、いきなり DOMで行うよりも、「いつも隣にIT」のような IEオブジェクトを使った方がわかりやすいと思います。他に、Google Chrome はアドオンの違う言語で動かすことができるようですし、Microsoft Edge は、SeleniumVBAというExcel用のアドインを必要としますが、いつもアプリ側の対応が遅れてしまい、むしろ、別の言語でコントロールした方がよいそうです。
---------------------
Webデータを取り込む方法...実際

最初に、以下は典型的な基本形です。
ご自身で作った方が楽しみは大きいのですが、何もないままでは次にどうしてよいか分かりません。

次の課題は、
球団別個人成績-球団の選択- 打撃成績- 投手成績 -守備成績-選択
この部分を、VBAでコントロールするということが残されていますが、それはよかったらまた考えてみましょう。

また、この中で、必要な情報だけを取り出したいという場合、7つ目という方法は、
Rows(7-1) になるはずです。つまり、6ということです。-1は、0から始まるからです。
1行だけでもよいですし、

それ以外にも、
  For j = 0 To .Rows(i).Cells.Length - 1
 ここで、ループしていますから、Rows(i).Cells(0).innerText で、IF 関数で取得してよいか判定してもよいと思います。不要になったら、Exit For や Goto で、ループを出てもよいと思います。

いつも隣にITでは、
Dim htmlDoc As HTMLDocument 'HTMLドキュメントオブジェクトを準備
としていますが、開発する時は、直接、IEオブジェクトで行った方がわかりやすいはずです。

'//
Sub GetNPBdata()
 Dim objIE As SHDocVw.InternetExplore  '参照設定(Microsoft Internet Control)
 Dim UrlBase As String: UrlBase = "http://npb.jp/bis/ 'ベースURL
 Dim i As Long, j As Long
 Dim ret As Varian '戻り値
 Dim Yr: Yr = "2017" '年の選択
 Dim Team
 Const TEAMS1 As String = "1.日本ハム,2.ソフトバング,3.ロッテ,4.西武,5.楽天"
 Const TEAMS2 As String = "6.オリックス,7.広島,8.巨人,9.DeNA,10.阪神,11.ヤクルト,12.中日"
 Const init As String = "f,h,m,l,e,bs,c,g,db,t,s,d"
 Dim inits '配列変数
 inits = Split(init, ",")
 ret = Application.InputBox(TEAMS1 & vbCrLf & TEAMS2, "球団リスト", "数字を選んでください")
 If Not (IsNumeric(ret) And ret > 0 And ret < 13) Then Exit Sub '12球団選択
 Team = inits(Val(ret) - 1)
 If ActiveSheet.UsedRange.Cells.Count > 2 Then
  If MsgBox("データを消去してよろしいですか?", vbQuestion + vbOKCancel) = vbCancel Then Exit Sub
  ActiveSheet.UsedRange.Cells.ClearContents
 End If
 On Error GoTo errHandler
 Set objIE = New SHDocVw.InternetExplorer
 objIE.Visible = Tru  'IEを表示
 strURL = UrlBase & Yr & "/stats/idb1_" & Team & ".html 'URLの完成
 objIE.Navigate2 strURL
 Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
 ''ここで初めて objIEの準備が整います。
 With objIE
   Set ttl = .document.getElementById("stdivtitle")
   Cells(1, 2).Value = ttl.innerText
   Cells(1, 2).WrapText = False
   Set tbl = .document.getElementsByTagName("Table")
   Application.ScreenUpdating = False
   With tbl(0)
    For i = 0 To .Rows.Length - 1
     For j = 0 To .Rows(i).Cells.Length - 1
       Cells(i + 2, j + 2).Value = .Rows(i).Cells(j).innerText
     Next j
    Next i
   End With
   Application.ScreenUpdating = True
  .Quit 'IEの終了
 End With
 AppActivate "Microsoft Excel", True
 MsgBox "正常終了しました。", vbInformation
errHandler:
 Set objIE = Nothin '必ずこうしないと後でトラブルを起こします。
 If Err.Number <> 0 Then
  MsgBox Err.Number & ": " & Err.Description
 End If
End Sub
    • good
    • 0
この回答へのお礼

WindFaller様

詳細にありがとうございます!

記載頂いたマクロを実行してみました。(アドレス等、一部修正のうえ)
Set ttl = .document.getElementById("stdivtitle")

「型が一致しません」が出てしまいました。

ただ、詳細に解説いただいているのと
三流君のページに参考に自分なりに頑張ってみます。

法律も気にしないといけないのですね。。
ご指摘ありがとうございました。

お礼日時:2018/03/18 18:37

こんばんは。



ActiveSheet.QueryTables.Add
して同じ場所で、QueryTables.Add を繰り返すことは基本的にはできないです。Add を使う場合は、予め、一旦、QueryTable を削除しないとできないはずです。

With ActiveSheet
If .QueryTables.Count > 0 Then
.QueryTables(1).Delete
.UsedRange.ClearContents 'コピー&ペーストはしている前提です。
End If
With .QueryTables.Add....
 ・
 ・
 ・
End With
End With

ところで、初めてみるサイトではあるのですが、典型的なWebクローリングの練習台のような気がします。Query ではない方法で、取り組んでみると、Webを利用したVBAの勉強になると思います。
    • good
    • 0
この回答へのお礼

回答ありがとうございます!!

QueryTableは都度deleteしていました。(QueryTableが含まれているシートごと毎回削除していました)
ただ、頂いた構文に書き換えたら処理自体は途中で止まらなくなりました。
ありがとうございます!!
とても助かりました。

QueryTableではない方法にぜひ取り組んでみたいのですが、、
勉強の参考になるサイト等ご存知でしたら教えていただけますか。
自分で探してみた結果、今は↓を参考にしているのですが、いまいち難しくて。。。
https://tonari-it.com/vba-ie-list/

お礼日時:2018/03/18 09:47

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

QVBAマクロ実行時エラーの修正について

VBA超初心者です。

CSVファイルをインポートし、データ更新すると、下記エラーが起こります。

実行時エラー '-2147021882 (8007000e)'
データの消失を防ぐため、空白でないセルをワークシートの外にシフトすることはできません。
Ctrl+Endキーを押して最後の空白でないセルに移動し、そのセルとデータの末尾との間にある
すべてのセルを削除またはクリアしてください。その後、セルA1を選択し、ブックを保存して最後の
セルをリセットしてください。

(以下にも文章ありますが、一部しか表示されません)

この時、「デバック」ボタンを押すと、以下のマクロ表示となります。

Sub データ更新()

’データ更新日報出力Macro
’マクロ記録日:○○○ ユーザ名:○○


  ScreenUpdating = False
Worksheets("sheet1")Select
Range("A2").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
  Range("A2").Select
End Sub

Sub ピボットテーブル更新日報印刷()
   Sheets("Sheet2").Select
Range("B14").Select
ActiveSheet.PIvotTables("ピボットテーブル1").RefreshTable
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:True
End Sub


この構文で、Selection.QueryTable.Refresh BackgroundQuery:=False が
 間違っているようなのですが、どうすればいいのか良くわかりません。
 どなたか教えていただけないでしょうか?

VBA超初心者です。

CSVファイルをインポートし、データ更新すると、下記エラーが起こります。

実行時エラー '-2147021882 (8007000e)'
データの消失を防ぐため、空白でないセルをワークシートの外にシフトすることはできません。
Ctrl+Endキーを押して最後の空白でないセルに移動し、そのセルとデータの末尾との間にある
すべてのセルを削除またはクリアしてください。その後、セルA1を選択し、ブックを保存して最後の
セルをリセットしてください。

(以下にも文章ありますが、一部しか表示されません)

こ...続きを読む

Aベストアンサー

>Selection.QueryTable.Refresh BackgroundQuery:=False
この『構文』自体が間違っているわけではありません。
"sheet1"のA2セルに設定されているQueryTable(外部データ取り込み)
を更新する時に、エラーが発生して更新できない、という意味です。

おそらく、エラー原因はエラーメッセージそのままではないでしょうか。
『..空白でないセルをワークシートの外にシフトすることはできません..』

QueryTableの設定によっては、取り込みデータを挿入するようになっています。
例えば、シートの最下行にデータがあって、
取り込みデータを挿入するとデータがはみ出てしまう、という場合は
そういったエラーメッセージが出る事も考えられます。
#こちらの環境では再現できなかったので半分自信なしですが -"-

対策もエラーメッセージに書かれている通りです。
例えば"sheet1"で使用中のデータの最終行が1,000行だと思っていても、
それ以下になんらかの使用領域が残っている可能性があります。
Ctrl+Endキーを押してみてください。
"sheet1"の実際の最終セルに移動します。
その行から1,001行目までを選択して削除してください。
(実際に必要なデータがないかどうかを確認の上で。)
その後ブックを保存してください。

以上で解消すれば良いのですが。

または、QueryTableの設定を変更してみる方法もあります。
"sheet1"のA2セルを選択して右クリック。
[データ範囲のプロパティ]を開きます。
『変更されたレコード(行)のデータ更新時の処理:』

○新しいデータのセルを挿入し、使用されていないセルを削除する
になっていたら、
○既存のセルを新規データで上書きし、使用されていないセルはクリアする
に変更してみてください。

いずれかでも解消できない場合は
現在のシート状態と実際の利用の仕方などの詳細情報があると
他にアドバイスあるかもしれません。
(例えば外部データを取り込んだ後に数式や書式を設定していたりとか、
 何かの図形を配置しているとか)

>Selection.QueryTable.Refresh BackgroundQuery:=False
この『構文』自体が間違っているわけではありません。
"sheet1"のA2セルに設定されているQueryTable(外部データ取り込み)
を更新する時に、エラーが発生して更新できない、という意味です。

おそらく、エラー原因はエラーメッセージそのままではないでしょうか。
『..空白でないセルをワークシートの外にシフトすることはできません..』

QueryTableの設定によっては、取り込みデータを挿入するようになっています。
例えば、シートの最下行にデータがあ...続きを読む


人気Q&Aランキング