エクセルVBAでスクレイピングしているのですが、その時に必要なのが設定テーブル
スクレイピングそのものよりも設定ファイルのインプットやアウトプットが重要だったりします。
設定テーブルには
・開始時刻
・IDやらパスワード
・遷移先URL
など様々な情報が記載されており、随時更新されます。
コピーして貼り付けるが面倒なので、
以降元のエクセルファイルを開いて移行先のエクセルファイルにコピーする記述を追加しました。
※スクレイピングに使用した設定ファイルを保存するために、一つの設定ファイルの使いまわしはしないものとする。
前提
エクセルVBA利用
・コピー元 別ファイル 「設定」シートにあるテーブル
・コピー先 このファイル「設定」シートにあるテーブル
・コピー元・コピー先とも「設定」シートにテーブルは1つ
必要な機能
・①コピー元エクセルシートのフルパスを取得
・②コピー先のテーブルデータを消す
・③コピー元のテーブルデータをコピー先テーブルにコピーする。
①コピー元エクセルシートのフルパスを取得する
ネットで検索したらたくさんでてくるのでここでは省略
↓わかりやすいです
VBAでファイルの選択ダイアログを表示してファイルのパスを取得
②コピー先のテーブルデータを消す
こちらもネットで検索したら多数でてきます。↓
Excelのテーブルから最速で全行削除する
Dim myTable As ListObject
Set myTable = ThisWorkbook.Sheets("Sheet1").ListObjects("テーブル1")
If Not (myTable.DataBodyRange Is Nothing) Then
myTable.DataBodyRange.Delete
End If
③コピー元のテーブルデータをコピー先テーブルにコピーする。
・その後にスクレイピングが続くのでコピー処理は軽めに
・バッチから起動したり、pythonから起動したりするのでコピー処理は高速に
・急いでつくらないといけないので簡単に
・バッチ起動で失敗しないために、基本フルパスを使う。
この二つを考慮して作ったのが↓
'*******************************************************************************
' 別ファイルのテーブルデータをこのファイルのテーブルにコピーする
' コピー元、コピー先ともに「設定」シートにある「設定テーブル」テーブルとする
' コピー元、コピー先ともに「設定」シートには「設定テーブル」のみあるものとする
'「設定テーブル」はA1から始まるものとする
'************************
Sub setSheet()
Dim AppObj As Object 'Excel.Applicationオブジェクトの宣言
Dim WBObj As Object 'Excel.Workbookオブジェクトの宣言
Dim WsObj As Object 'Excel.WorkSheetオブジェクトの宣言
Dim WsObjother As Object 'Excel.WorkSheetオブジェクトの宣言 その他のワークブック
Dim FilePath As String
Dim SheetNameE As String '設定ファイルのシート名
Dim A As Variant
Dim lastrow As Long
Dim lastcolumn As Long
Dim myTable As ListObject
Application.ScreenUpdating = False '画面描画しない
SheetNameE = "設定" 'テーブルのあるシート名
FilePath = ThisWorkbook.Sheets("各種設定").Range("A2").Value
'↑このファイルの各種設定シートのA2にコピー元エクセルのフルパスがあるものとします。
Set WBObj = Workbooks.Open(FilePath) 'コピー元ワークブックを開く
Set WsObjother = WBObj.Sheets(SheetNameE) 'コピー元エクセルの「設定」シート
'「設定」シートにあるテーブルデータ(見出し含まない)の取得
Set A = WsObjother.Range("A1").ListObject.DataBodyRange
lastrow = A.Rows.Count 'テーブルの最終行
lastcolumn = A.Columns.Count 'テーブルの最終列
'このワークブックのテーブルデータの削除
Set myTable = ThisWorkbook.Sheets(SheetNameE).ListObjects("設定テーブル")
If Not (myTable.DataBodyRange Is Nothing) Then
myTable.DataBodyRange.Delete
End If
'このシートのA2から貼り付け
With WsObjother
.Range(.Cells(2, 1), .Cells(lastrow + 1, lastcolumn)).Copy ThisWorkbook.Sheets(SheetNameE).Cells(2, 1)
End With
WBObj.Close SaveChanges:=False 'コピー元エクセルを閉じる
Set WsObj = Nothing
Set WBObj = Nothing
Application.ScreenUpdating = True '画面描画をする
注意点
1 テーブル名が「設定テーブル」でないと
Set myTable = ThisWorkbook.Sheets(SheetNameE).ListObjects("設定テーブル")
が止まります。
2 設定テーブル」はA1から始まっているものとする
Set A = WsObjother.Range("A1").ListObject.DataBodyRange
が止まります。
3 コピー元ファイルのフルパスは「各種設定」シートのA2にあるものとする
FilePath = ThisWorkbook.Sheets("各種設定").Range("A2").Value
4 画面更新の非表示が無効になります。
他の箇所で画面表示を非表示にしている場合次の記述は削除する。
Application.ScreenUpdating = True
逆に動的にしたい場合は上記の箇所を随時変更すればよいということです。