2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

VBA 別ファイルのテーブルデータをコピーして貼り付けする

Posted at

エクセル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   

逆に動的にしたい場合は上記の箇所を随時変更すればよいということです。 

2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?