三流君 ken3のmemo置き場

メモ置き場、保管庫として利用。まとまっていませんがヨロシク

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
(※詳細は[三流君 三流プログラマーとは?]を見てください)


広告:


[記事一覧、バックナンバーを見る]

Excel Formから起動済みのIEを選択 テーブルを取得するテスト

前回
ken3memo.hatenablog.com
の続きです。

XXXXXさんより、下記の質問が来ました。

> 【VBA IE操作】テーブル単体を取り出す  にて勉強中の老人です。
> 上記サンプルはURLを記述して表示して
>WEBページにテーブルの内容を取得しておりますが、
>当方も目的はページを次から次に切り替えて
>その都度にテーブルの内容をEXCLEに蓄積したいと思っ
> てます。(手動で開いたページのテーブル等)

と、
既存IEを手動で操作して、データを抜く、
そんな質問が来ました。

前回、既存IEの取得まで行ったので、
今回は、
テストでテーブルを探し、
選択されたテーブル
をセルに書き出したいと思います。

いつもの 酔っ払い フラフラ解説動画・・・
Excel VBA Formから起動済みのIE選択 TABLEを.getElementsByTagName("TABLE")で取得 TEST【三流君】 - YouTube
www.youtube.com

過去に作成した
ken3memo.hatenablog.com

    'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    Dim objTABLEs As Object 'TABLEを複数 格納用
    
    'TABLEタグを複数取り出す
    Set objTABLEs = objIE.document.getElementsByTagName("table")

    'まず、書き込み先シートに切り替え、データをクリアする
    Sheets("DATA").Select    'シートを切り替える
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、
    
    '表をDATAシートに書き出す
    Dim j As Integer  '列の管理
    Dim i As Integer  '行の管理
    Dim n As Integer  'TABLEの管理
    Dim yy As Integer 'セットする行
    Dim aa As String  '一時保管用
    
  
  'Webの表をシートへ転記(代入する)
  yy = 1  'セットする位置を初期化
  
  For n = 0 To objTABLEs.Length - 1  'TABLEの数ループ
    
    For i = 0 To objTABLEs(n).Rows.Length - 1 '行の数 ループ
    
       For j = 0 To objTABLEs(n).Rows(i).Cells.Length - 1  '列のループ
            'objTABLEs(テーブル).Rows(行).Cells(列).テキスト値
            aa = objTABLEs(n).Rows(i).Cells(j).innerText
            Sheets("DATA").Cells(yy, j + 1) = aa
       Next j
       
       yy = yy + 1   'セット位置 行を増やす
    
    Next i
    
  Next n

↑を参考に

'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
Dim objTABLEs As Object 'TABLEを複数 格納用
'TABLEタグを複数取り出す
Set objTABLEs = objIE.document.getElementsByTagName("table")
で、
テーブル全体を取り出し、
コンボボックスに左上の見出しを書き込みます。

テーブルの左上は、
ken3memo.hatenablog.com
より
Wscript.ECHO objTABLE(n).Rows(0).Cells(0).InnerTEXT
みたいに、
Rows(0)
Cells(0)
でわかるので、

Private Sub btnテーブル探す_Click()
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    Dim objTABLEs As Object 'TABLEを複数 格納用
    Dim n As Integer
    Dim strWORK As String
    
    Me.cbTABLELIST.Clear  'TABLE選択用のコンボボックスをクリア、初期化
    
    'TABLEタグを複数取り出す
    Set objTABLEs = IE.document.getElementsByTagName("table")
    If objTABLEs.Length = 0 Then 'テーブルが見つからなかったら
        Me.txtINFO.Text = "TABLEが見つかりません"
        Exit Sub  '関数を抜ける
    End If
    
    'テーブルが見つかったら、
    Me.txtINFO.Text = "TABLEが" & objTABLEs.Length & "個 見つかりました" & vbCrLf
    For n = 0 To objTABLEs.Length - 1  'TABLEの数ループ
        '左上の見出しをコンボボックスへ
        strWORK = "TABLE(" & n & "):" & objTABLEs(n).Rows(0).Cells(0).innerText
        Me.cbTABLELIST.AddItem Left(strWORK, 80) 'コンボボックスへ追加
        Me.txtINFO.Text = Me.txtINFO.Text & strWORK & vbCrLf '情報エリアにも書く
    Next n

End Sub

↑で、コンボボックスを作成して、

次に、テーブルのコンボボックスを選択後に
Excelの書き出しを行うボタンを押してもらいます。

Private Sub btnExcel出力_Click()

    '未選択のチェック
    If Me.cbTABLELIST.ListIndex = -1 Then
        Me.Caption = "未選択 TABLEを選択してください" 'Formタイトルバーに未選択を表示
        Exit Sub  '関数を途中で抜ける
    End If
    
    
    '選択されていたら、作業シートに書き込む
    Dim 最終行 As Integer  '急に漢字の変数使うなよ・・・
    
    Sheets("作業").Select  'データセット先に切り替える
    最終行 = Cells(Rows.Count, 1).End(xlUp).Row + 1 '最終行+1からセットする
    Cells(最終行, 1).Select  'カーソルを移動させる
    DoEvents
    
    'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    Dim objTABLEs As Object 'TABLEを複数 格納用
    
    'TABLEタグを複数取り出す
    Set objTABLEs = IE.document.getElementsByTagName("table")

    '表をDATAシートに書き出す
    Dim x As Integer  '列の管理
    Dim y As Integer  '行の管理
    Dim n As Integer  'TABLEの管理
  
    'Webの表をシートへ転記(代入する)
    n = Me.cbTABLELIST.ListIndex 'コンボボックスの選択位置を代入
      
    For y = 0 To objTABLEs(n).Rows.Length - 1 '行の数 ループ
       For x = 0 To objTABLEs(n).Rows(y).Cells.Length - 1  '列のループ
            'objTABLEs(テーブル).Rows(行).Cells(列).テキスト値
            Cells(最終行 + y, 1 + x) = objTABLEs(n).Rows(y).Cells(x).innerText
       Next x
    Next y

    '書き込み終了メッセージ
    MsgBox "シートに書き込みました、確認してください"

End Sub

↑まぁ、これだと、結合セルの出力とかうまくいっていない。

あと、
テストで使ってみて、操作性が悪いですね。
いちいち、再取得のボタンを押さないとダメな点は、
改善が必要かなぁ。

Excelブックは
http://ie.vba-ken3.jp/test/Book20170808.zip
に保存しておきます。
これをたたき台として、アレンジして使ってみてください。

何か処理の参考となれば、幸いです。 三流プログラマー Ken3




三流君へ メッセージを送る

全ての質問に答えることはできませんが、
ダメもとで、気軽に質問、感想、メッセージを送ってくださいね・・・

感想や質問・要望・苦情など 三流君へメッセージを送る。
下記のフォームからメッセージを送ることができます。


あなたのお名前(ニックネーム):さん
返信は?:

アドレス:に返事をもらいたい
感想や質問↓:


(感想や質問・要望・苦情はHPで記事に載せることがあります。)
例:[XXXXさんへ回答例]←みたいに回答していたり...


Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。

三流解説動画の再生リスト
https://www.youtube.com/user/ken3video/playlists

本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)