vba | nujonoa_blog

条件付き書式を一括で消す場合は、「Cells.FormatConditions.Delete」

nujonoa — Thu, 20 Apr 2023 03:09:47 +0000

自分の忘備録です。

条件付き書式を一括で消す場合は、「Cells.FormatConditions.Delete」
実は動作が重い条件付き書式

条件付き書式を一括で消す場合は、「Cells.FormatConditions.Delete」

条件付き書式を一括で消す方法は、

イミディエントウインドで、

Cells.FormatConditions.Delete

を打ち込んでenterになります。

実は動作が重い条件付き書式

実はファイルが重くなってしまっている原因が、条件付き書式であることが多々ありますので、
一括で削除してどれくらいファイルの動きが軽くなるか、試してみるといいと思います！！！

VBA→VBSの変換！VBS→VBAの起動を！

nujonoa — Wed, 18 Aug 2021 13:43:00 +0000

VBA→VBSの変換！VBS→VBAの起動を！
コード
コードの説明
活用方法

VBA→VBSの変換！VBS→VBAの起動を！

VBAでファイル名の変更などを行った場合、
これを他の人にも展開したいなと考えることがあるかと思います。

そこでお勧めするのが、VBSを用いる方法です。

コード

Dim ExcelApp
Dim ExcelBook
Dim FilePath

FilePath = "G:\共有ドライブ\TEST_FOLDER\utf-8_to_shiftjis.xlsm" '←ここを変更
VBA_P = "TEST1" '←ここを変更

Set ExcelApp=CreateObject("Excel.Application")
Set ExcelBook= ExcelApp.Workbooks.Open(FilePath)
ExcelApp.ActiveWorkbook.Worksheets(1).select

ExcelApp.visible = false

ExcelApp.Run VBA_P

ExcelBook.Close True
ExcelApp.quit

Set ExcelApp=Nothing
Set ExcelBook=Nothing

コードの説明

コードは非常に簡単で、

Set ExcelApp=CreateObject("Excel.Application")
Set ExcelBook= ExcelApp.Workbooks.Open(FilePath)

でエクセルを立ち上げて

ExcelApp.ActiveWorkbook.Worksheets(1).select

でワークシートを指定して

ExcelApp.visible = false

ExcelApp.Run VBA_P

Excelを見えないように、マクロをはしらせ

ExcelBook.Close True
ExcelApp.quit

Set ExcelApp=Nothing
Set ExcelBook=Nothing

これで、エクセルを閉じております。

活用方法

活用方法としては、

1ヶ月、1週間毎に繰り返し行う集計、更新作業などを、
ワンクリックで更新することができるようになります。

また、

ExcelApp.visible = True '←F
'コメントに変換　ExcelBook.Close True

で、エクセルファイルをそのまま立ち上げたまま、
チェック作業に入ることも可能です。

【VBA】最終行、最終列を取得する方法3選

nujonoa — Sun, 31 Jan 2021 01:43:50 +0000

最終行、最終列を取得する方法を紹介します。

【VBA】最終行を取得する方法3選

【VBA】最終行を取得する方法3選

最終行、最終列をとってくるコードは、
「一番使うコードなのに」忘れてしまうんです…

ということで、今回は覚書で3種類さっと紹介したいと思います。

「Ctrl+↑」「Ctrl+←」を再現

「Ctrl+↑」「Ctrl+←」を再現して最終行を持ってくるのが、
下記プログラムです。
データが入っている行を選択してあげる必要があるので注意が必要です。

LASTY = Cells(Rows.Count, 2).End(xlUp).Row '1を任意に替える
LASTX = Cells(2, Columns.Count).End(xlToLeft).Column '1を任意に替える

Debug.Print LASTY, LASTX

「Ctrl+↓」「Ctrl+→」を再現

「Ctrl+↓」「Ctrl+→」を再現して最終行を持ってくるのが、
下記プログラムです。
こちらもデータが入っている行を選択してあげる必要があるので注意が必要です。

LASTY = Cells(1,3).End(xlDown).Row
LASTY = Cells(1,3).End(xlToRight).Column

最終行(空白はNG)を検出

使っている範囲をカウントするので、
空白行があると(最終行-空白行)が検出されてしまうのが、少々問題ですが、
一番きれいなのがこの関数です。

LASTY=ActiveSheet.UsedRange.Rows.Count
LASTX=ActiveSheet.UsedRange.Columns.Count

下記のような場合、上記のコードでは、
・LASTY=10
・LASTX=4
となってしまいます。
・使っている行として罫線もカウントされますので、
　11行目までカウントされますが、1行目は使ってないので、答えは11-1=10
・使っている列は、Eまでですカウントされますが、
　A列は使ってないので、5-1=4が返されます。
ですので、「A1セル」をタイトルか何かで埋めておく必要があります。

【VBA】アクティブシートを特定のフォルダに保存、アップロードする方法

nujonoa — Sun, 31 Jan 2021 01:22:00 +0000

DBフォルダを作ったはいいものの、残念ながら使われない。。
ということもあるかと思います。
そこで今回は、簡単にファイルをアップロードできるプログラムを紹介します。

【VBA】アクティブシートを特定のフォルダに保存、アップロードする方法
プログラム紹介
プログラム紹介
右クリックに追加

【VBA】アクティブシートを特定のフォルダに保存、アップロードする方法

ファイルをアップロードする作業がめんどくさいことで、
データが登録されなくなってしまったら、データベースは本末転倒です。

そこで今回は、アクティブシートをDBフォルダに登録するプログラムを紹介します。

プログラム紹介

プログラムは下記のとおりです。
※ダブルクリックでコピーできます。

'右クリックメニューに追加
Private Sub Auto_Open()
    With CommandBars("Cell").Controls.Add(Before:=1)
        .Caption = "ファイルアップロード(&P)"
        .OnAction = "ファイルアップロード"
    End With
End Sub

'ファイルを落とす際に、右クリックメニューから削除
Private Sub Auto_Close()
CommandBars("Cell").Controls("ファイルアップロード(&P)").Delete
End Sub

Sub ファイルアップロード()

'フォルダの選択
  Dim folderPath As Variant
  With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "C:\Downloads\"'←イニシャルで表示されるフォルダです。変更してください。
   If .Show = 0 Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If
   folderPath = .SelectedItems(1)
  End With
 
’ファイル名の選択
HOZONSAKI = folderPath & "\" 
HOZONMEI = Application.InputBox(Prompt:="ファイル名を入力してください。" & vbLf & vbLf, Type:=2, Default:=ActiveSheet.Name)'←初期値はシートネームにしています。
   If HOZONSAKI = False Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If

'パスの作成
FName = HOZONSAKI & HOZONMEI

'シートの複製
 ActiveSheet.Copy '名前を付け、ファイル形式も決めて特定の場所に保存する。
 ActiveWorkbook.SaveAs _
 Filename:=FName, _
 FileFormat:=xlOpenXMLWorkbook
 
  Application.DisplayAlerts = False
    ActiveWorkbook.Close
  Application.DisplayAlerts = True

End Sub

プログラム紹介

今回紹介するプログラムは、
セル上で、右クリック「ファイルアップロード」を選ぶと、
アクティブシートを指定したフォルダにアップロードできるプログラムになります。

まずは、アップロードを指定するプログラムがここになります。

With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "C:\Downloads\"'←イニシャルで表示されるフォルダです。変更してください。
   If .Show = 0 Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If
   folderPath = .SelectedItems(1)
  End With

保存名を決めるのが、下記ファイルです。

’ファイル名の選択
HOZONSAKI = folderPath & "\" 
HOZONMEI = Application.InputBox(Prompt:="ファイル名を入力してください。" & vbLf & vbLf, Type:=2, Default:=ActiveSheet.Name)'←初期値はシートネームにしています。
   If HOZONSAKI = False Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If

'パスの作成
FName = HOZONSAKI & HOZONMEI

右クリックに追加

このようなプログラムは、右クリックのメニューに追加して、
簡単に使うことができるようにすることが重要です。

下記プログラムは、右クリックにメニューを追加する部分になります。

'右クリックメニューに追加
Private Sub Auto_Open()
    With CommandBars("Cell").Controls.Add(Before:=1)
        .Caption = "ファイルアップロード(&P)"
        .OnAction = "ファイルアップロード"
    End With
End Sub

'ファイルを落とす際に、右クリックメニューから削除
Private Sub Auto_Close()
CommandBars("Cell").Controls("ファイルアップロード(&P)").Delete
End Sub

【VBA】SaveAsでファイルに連番を追加し重複を防ぐ方法

nujonoa — Sun, 31 Jan 2021 01:15:16 +0000

VBAでSaveAsを使う際に、上書き保存するとそのままエクセルが落ちる現象が散見されました。

そこで、今回は、保存先フォルダに同一の名前が含まれるファイルがあった場合に、
連番を付けて登録するプログラムを作成しました。

【VBA】SaveAsでファイルに連番を追加し重複を防ぐ方法
プログラムの説明

【VBA】SaveAsでファイルに連番を追加し重複を防ぐ方法

SaveAsでファイルを保存する際に、
連番を追加し重複を防いで保存するプログラムを下記に示します。
※ダブルクリックでコピーできます。

Sub ファイルに連番を付けて保存()

Application.ScreenUpdating = False

'保存先フォルダを選択*開始**************************************
  MsgBox "保存先フォルダを選択"
  Dim folderPath As Variant
  With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "C:\Users\"
   If .Show = 0 Then
     MsgBox "キャンセルボタンをクリックしました。"
     Exit Sub
   End If
   folderPath = .SelectedItems(1)
  End With
'保存先フォルダを選択*終了**************************************

'保存名を入力*開始***************************************************
FileName = Application.InputBox(Prompt:="名前を入力してください。" & vbLf & vbLf, Type:=2, _
           Default:=ActiveSheet.Name & "_" & Year(Now) & Month(Now) & Day(Now))
   If FileName = False Then
     MsgBox "キャンセルボタンをクリックしました。"
     Exit Sub
   End If
'保存名を入力*終了***************************************************
   
'名前のダブり確認*開始***************************************************
        fn = "*" + FileName + "*"
        fnd = Dir(folderPath + "\" + fn, vbNormal)
        I = 0
        'ファイルがない場合
        If (fnd = "") Then
            GoTo CONTINUE1
        'ファイルがあった場合
        Else
        Do While fnd <> ""
           fnd = Dir '次のファイル
           I = I + 1
        Loop
        End If
        FileName = FileName & "(" & I & ")"

CONTINUE1:

'名前のダブり確認*終了***************************************************

FName = folderPath & "\" & FileName

'ファイルの保存***************************************************
    Worksheets.copy
    ActiveWorkbook.SaveAs _
    FileName:=FName, _
    FileFormat:=xlOpenXMLWorkbook
　'ファイルを閉じる
  Application.DisplayAlerts = False
    ActiveWorkbook.Close
  Application.DisplayAlerts = True

'ファイルの保存終了***************************************************


Application.ScreenUpdating = True

 
End Sub

プログラムの説明

プログラムの肝は、この部分になります。
Dir(ファイルパス)関数で、ファイルの存在を確認し、
もしファイルがあった場合、連番の数字を繰り上げていく形になります。

'名前のダブり確認*開始***************************************************
        fn = "*" + FileName + "*"
        fnd = Dir(folderPath + "\" + fn, vbNormal)
        I = 0
        'ファイルがない場合
        If (fnd = "") Then
            GoTo CONTINUE1
        'ファイルがあった場合
        Else
        Do While fnd <> ""
           fnd = Dir '次のファイル
           I = I + 1
        Loop
        End If
        FileName = FileName & "(" & I & ")"

CONTINUE1:

'名前のダブり確認*終了***************************************************

fnでファイル名を含むすべてのファイルを検索していますが、

        fn = "*" + FileName + ".Xls*"

とすると、エクセルのファイルだけを検出して避けることが可能です。

あとは、名前野田ぶりを無くしたので、ファイルを保存して終了です。
Worksheets.copy
の後に何もつけないと、新しいブックにコピーされますので、
SaveAsで保存して終了です。

FName = folderPath & "\" & FileName

'ファイルの保存***************************************************
    Worksheets.copy
    ActiveWorkbook.SaveAs _
    FileName:=FName, _
    FileFormat:=xlOpenXMLWorkbook
　'ファイルを閉じる
  Application.DisplayAlerts = False
    ActiveWorkbook.Close
  Application.DisplayAlerts = True

'ファイルの保存終了***************************************************

【VBA】列の英語→数字に変換する方法

nujonoa — Fri, 29 Jan 2021 14:12:49 +0000

VBAでプログラムを組んでいると、正直R1C1表記で行きたいところが、
自分以外でも使うことを考えて、そのままの設定で行くことが多いです。

そんな時に困るのが、列の英語(アルファベット)と数字の対比です。

今回はそんな列の英語を数字にする方法を紹介していきたいと思います。

【VBA】列の英語(アルファベット)⇒数字に変換する方法
プログラムの説明
≪参考≫数字→アルファベット

【VBA】列の英語(アルファベット)⇒数字に変換する方法

列の英語を数字に変換する方法は、
下記のとおりです。※ダブルクリックしてコピーできます。

Sub AA()

'英語→数字に変換
    RETU = InputBox("列名(英語)を入力", , "AU")
    RETUN = Cells(1, RETU).Column
    MsgBox RETUN
'<参考>数字→英語に変換
    Dim RETU2 As Integer
    RETU2 = InputBox("数字を入力", , "95")
    RETUN2 = Cells(2, RETU2).Address(ColumnAbsolute:=False)
    RETUN2 = Left(RETUN2, InStr(RETUN2, "$") - 1)
    MsgBox RETUN2

End Sub

プログラムの説明

実は、CELLSの使い方として

Cells(1, "C")

と表記すると、セル「C1」を選択することが可能です。
こんな使い方をする人は少ないので知られていませんが。。

ですので、セルの.Columnと組み合わせて、

Cells(1, "C").Column

で、セルの英語を数字に変換することが可能です。

charなどを用いる方法がありますが、これが一番簡単だと思います。

≪参考≫数字→アルファベット

参考までに数字→アルファベットに変換する方法は、

.Address(ColumnAbsolute:=False)

を用いて、セルのアドレスを「CA$1」で表し、

「InStr("CA$1", "$")」で$を検索。その前までの英語を取り出します。

【VBA】msgboxで3択を行うには？コピペで簡単。

nujonoa — Thu, 28 Jan 2021 12:58:03 +0000

msgboxでの3択の使い方の例を記載しました！
参考にしてください！！

【VBA】msgboxで3択を行うには？コピペで簡単。
プログラム説明

【VBA】msgboxで3択を行うには？コピペで簡単。

msgboxで3択をする方法です。
※ダブルクリックでコピーできます。

SUB 3TAKU()
flag = 0

flag = MsgBox("○○なら→はい" & vbCrLf & "△△なら→いいえ" & vbCrLf & "□□なら→キャンセル", 3 + 32) '16:警告 32:問い合わせ 48:注意 64:情報
If flag = 6 Then
    MsgBox "処理1"
ElseIf flag = 7 Then
    MsgBox "処理2"
ElseIf flag = 2 Then
    MsgBox "処理3"
End If

END SUB

プログラム説明

msgboxで綺麗に三択を行う方法は、残念ながらありません。
本当は回答を決めれたらいいのですが、、、

そのため、msgboxで3択を行うためには、

msgbox("○○なら→はい" & vbCrLf & "△△なら→いいえ" & vbCrLf & "□□なら→キャンセル", 3)

を用いて、yes, no, キャンセルで分岐させることをお勧めします。
少々質問文が長くなりますが、これで十分役目は果たせます。

【VBA】質問、分岐付きmsgbox、コピペで簡単。

nujonoa — Thu, 28 Jan 2021 12:50:34 +0000

よく使うけど忘れる。。msgboxの使い方をまとめました。

【VBA】質問付きmsgbox、コピペで簡単。
プログラム説明

【VBA】質問付きmsgbox、コピペで簡単。

質問、分岐付きのmsgboxのコード一覧です。
※ダブルクリックでコピーできます。

Sub msgbox1()

    Dim flag As Integer


' vbOKOnly    0   [OK]ボタンのみを表示します

    MsgBox ("AA")
    
'vbOKCancel  1   [OK]ボタンと[キャンセル]ボタンを表示します

    flag = 0
    
    flag = MsgBox("OK" & vbCrLf & "キャンセル?", 1 + 32) '16:警告 32:問い合わせ 48:注意 64:情報
    If flag = 1 Then
        MsgBox "OK"
    ElseIf flag = 2 Then
        MsgBox "キャンセル"
    End If
    

    

'vbAbortRetryIgnore  2   [中止]、[再試行]、および[無視]の３つのボタンを表示します

    flag = 0
    
    flag = MsgBox("中止" & vbCrLf & "再試行" & vbCrLf & "無視", 2 + 32) '16:警告 32:問い合わせ 48:注意 64:情報
    If flag = 3 Then
        MsgBox "中止"
    ElseIf flag = 4 Then
        MsgBox "再試行"
    ElseIf flag = 5 Then
        MsgBox "無視"
    End If


'vbYesNoCancel   3   [はい]、[いいえ]、および[キャンセル]の３つのボタンを表示します

    flag = 0
    
    flag = MsgBox("はい" & vbCrLf & "いいえ" & vbCrLf & "キャンセル", 3 + 32) '16:警告 32:問い合わせ 48:注意 64:情報
    If flag = 6 Then
        MsgBox "はい"
    ElseIf flag = 7 Then
        MsgBox "いいえ"
    ElseIf flag = 2 Then
        MsgBox "キャンセル"
    End If

'vbYesNo 4   [はい]ボタンと[いいえ]ボタンを表示します

    flag = 0
    
    flag = MsgBox("はい" & vbCrLf & "いいえ", 4 + 64) '16:警告 32:問い合わせ 48:注意 64:情報
    If flag = 6 Then
        MsgBox "はい"
    ElseIf flag = 7 Then
        MsgBox "いいえ"
    End If




'vbRetryCancel   5   [再試行]ボタンと[キャンセル]ボタンを表示します

    flag = 0
    
    flag = MsgBox("再試行" & vbCrLf & "キャンセル", 5 + 48) '16:警告 32:問い合わせ 48:注意 64:情報
    If flag = 4 Then
        MsgBox "再試行"
    ElseIf flag = 2 Then
        MsgBox "キャンセル"
    End If


'番外編　INPUTボックス
MOJI = InputBox("質問はここ", "タイトルはここ", "デフォルトの数字はここ")


    
End Sub

プログラム説明

msgboxには、色々な種類があり、判断に迷いますが、
①ただのメッセージ
②2択の質問
③3択の質問
に分けられます。

また、ここで厄介なのが、
質問が2択であれば、返り値は1，2でいいのに、それぞれの値を持っています。

これに限っては、コピペに限ります。
是非下のコードをお使いください。

2択のメッセージ

'vbOKCancel 1 [OK]ボタンと[キャンセル]ボタンを表示します

flag = 0

flag = MsgBox("OK" & vbCrLf & "キャンセル?", 1 + 32) '16:警告 32:問い合わせ 48:注意 64:情報
If flag = 1 Then
    MsgBox "OK"
ElseIf flag = 2 Then
    MsgBox "キャンセル"
End If

'vbYesNo 4 [はい]ボタンと[いいえ]ボタンを表示します

flag = 0

flag = MsgBox("はい" & vbCrLf & "いいえ", 4 + 64) '16:警告 32:問い合わせ 48:注意 64:情報
If flag = 6 Then
    MsgBox "はい"
ElseIf flag = 7 Then
    MsgBox "いいえ"
End If

'vbRetryCancel 5 [再試行]ボタンと[キャンセル]ボタンを表示します

flag = 0

flag = MsgBox("再試行" & vbCrLf & "キャンセル", 5 + 48) '16:警告 32:問い合わせ 48:注意 64:情報
If flag = 4 Then
    MsgBox "再試行"
ElseIf flag = 2 Then
    MsgBox "キャンセル"
End If

3択のメッセージ

'vbAbortRetryIgnore 2 [中止]、[再試行]、および[無視]の３つのボタンを表示します

flag = 0

flag = MsgBox("中止" & vbCrLf & "再試行" & vbCrLf & "無視", 2 + 32) '16:警告 32:問い合わせ 48:注意 64:情報
If flag = 3 Then
    MsgBox "中止"
ElseIf flag = 4 Then
    MsgBox "再試行"
ElseIf flag = 5 Then
    MsgBox "無視"
End If

'vbYesNoCancel 3 [はい]、[いいえ]、および[キャンセル]の３つのボタンを表示します

flag = 0

flag = MsgBox("はい" & vbCrLf & "いいえ" & vbCrLf & "キャンセル", 3 + 32) '16:警告 32:問い合わせ 48:注意 64:情報
If flag = 6 Then
    MsgBox "はい"
ElseIf flag = 7 Then
    MsgBox "いいえ"
ElseIf flag = 2 Then
    MsgBox "キャンセル"
End If

ただのメッセージ

' vbOKOnly 0 [OK]ボタンのみを表示します

MsgBox ("AA")

'番外編　INPUTボックス

MOJI = InputBox("質問はここ", "タイトルはここ", "デフォルトの数字はここ")

【VBA】右クリックのメニューにマクロを追加する方法

nujonoa — Thu, 28 Jan 2021 12:17:33 +0000

右クリックにマクロを登録すると非常にマクロの有用性が広がります。
また、年配の方にも使いやすいプログラムになりますので、
ぜひ覚えていってください！！

【VBA】右クリックのメニューにマクロを追加する方法
プログラム説明
1. メニューの登録と削除
2. Auto_Open()　Auto_Close()　との組み合わせ
途中で落ちてしまった時、、

【VBA】右クリックのメニューにマクロを追加する方法

右クリックのメニューのVBAのプログラムを登録する方法は、下記の通りです。
※ダブルクリックでコピーできます。

'ブックが開いた時に、右クリックに登録
Private Sub Auto_Open()

    With CommandBars("Cell").Controls.Add(Before:=1)  '1が一番上
        .Caption = "RC_TEST(&P)" '表示名
        .OnAction = "TEST" 'プログラム名
    End With

End Sub
'ブックを閉じたときに、右クリックのメニューを消す。
Private Sub Auto_Close()
    
CommandBars("Cell").Controls("RC_TEST(&P)").Delete

End Sub

’実行するプログラム
Sub TEST()

MsgBox "右クリック"

End Sub

プログラム説明

メニューの登録と削除

上記の通り、

右クリックで登録するだけなら、

    With CommandBars("Cell").Controls.Add(Before:=1)  '1が一番上
        .Caption = "RC_TEST(&P)" '表示名
        .OnAction = "TEST" 'プログラム名
    End With

で終わりなのですが、
これを実行したままにすると、なんと、メニューがそのまま残り続けます。
※今回の場合、　「RC_TEST(&P)」　のメニューが残り続ける。

ですので、きちんとメニューを消すことが大事です。

そのプログラムが、

CommandBars("Cell").Controls("RC_TEST(&P)").Delete

となっています。
表示名と一致しないときちんと消えないので、ご注意ください。

Auto_Open()　Auto_Close()　との組み合わせ

メニューを作った後に、きちんと消す必要がありますので、
基本的にはAuto_Open()　Auto_Close()との相性が抜群になります。

そのブックを立ち上げたときに、自動的にメニューが追加されますので、
そのブックで使えるプログラムを登録しておきましょう！！

途中で落ちてしまった時、、

途中でプログラムが落ちてしまった時は、

メニューが残ったままになってしまいます。。
非常に邪魔ですので、

'右クリックのメニューの初期化は
Application.CommandBars("Cell").Reset

で、初期化してあげてください。
右クリックに常時追加してあるメニューも消えますのでご注意ください。

【簡単】VBAとIEでページ内の商品情報(div)を順番にすべて取り出す方法

nujonoa — Tue, 15 Sep 2020 23:00:00 +0000

【簡単】VBAとIEでページ内の商品情報(div)を順番にすべて取り出す方法
コードサンプル
重要な要素を簡単に説明
まとめ

【簡単】VBAとIEでページ内の商品情報(div)を順番にすべて取り出す方法

VBAを用いてIEを動かし、HTMLの情報を持ってくることに慣れてくると、

Div

の内容を書き出したいという要望が出てくると思います。

というのも、「DIV」とは、単体では特に意味を持たないタグですが、

で囲った部分をブロックレベル要素としてグループ化することができるタグになっています。

グループ化することで、
・水平方向の位置をまとめて指定したり、
・指定した範囲にスタイルシートを適用したりすることができる
ため、商品の情報などは、divタブに囲まれていることが多々あります。

例えば、楽天の商品ですが、下記のように、
div でグループ化されており、
class="dui-card searchresultitem"が紐づけられています。

ですので、商品情報を持ってきたい場合、
classnameが、"dui-card searchresultitem"のdivの内容順番に取り出すて行くことで、
表示されているページの、商品情報の一覧を得ることができます。

コードサンプル

コードのサンプルとして、
「ふるなび」のあるページの商品情報を持ってくるコードを書いてみました。

ふるなびの場合、"product-info"がクラスネームになっておりますので、

・If A.className = "product-info" Then　(product-infoだった場合、)
・For Each B In A.ALL　　(div内の要素を取りだし)
・YOUSO(i + 1, J) = B.INNERTEXT　(innertextを配列に格納)

最後にエクセル内に書き出すことで、商品情報一覧を書き出しています。

Sub IEoutput2()
  
 Application.ScreenUpdating = False
   
'IEの起動
Dim objIE As Object
   
Set objIE = GetObject("", "InternetExplorer.Application")
   
objIE.Visible = True
       
       
    objIE.Navigate "https://furunavi.jp/Product/Search?subcategoryid=164,165,166,167,168&categoryid=17&order=3&layout_toggle=2&pagesize=100"  ' このURLを任意に変更
       
    ' ページの表示完了待ち｡
    While objIE.ReadyState <> 4 Or objIE.Busy = True
        DoEvents
    Wend
   
    On Error Resume Next      '値がないとエラーが出るので、エラー回避用
  
    i = 1  '開始行を指定
    J = objIE.document.ALL.Length  '要素の数を知る
      
     
     Dim A As Object
     
        Application.Wait Now() + TimeValue("00:00:03")
     
       
    Dim YOUSO(10000, 0 To 14) As String
    J = 0
        
    For Each A In objIE.document.getElementsbytagname("*")
    
    If A.className = "product-info" Then

        For Each B In A.ALL
         YOUSO(i + 1, J) = B.INNERTEXT
         J = J + 1
         
        Next

        J = 0
        i = i + 1
           
       
    End If
                    

        
    Next
      
    Range(Cells(2, 2), Cells(i, 15)) = YOUSO
 
     Cells.WrapText = False
  
  
 Application.ScreenUpdating = True
 Application.StatusBar = False
  
   
End Sub

重要な要素を簡単に説明

特に難しいところはないと思いますが、特定のページを立ち上げた後、

まずは、

For Each A In objIE.document.getElementsbytagname("*")

で、HTMLのすべての要素を検索しに行っています。

その中で、classnameが特定の値であった場合、分岐させて、

For Each B In A.ALL

で次はdivの中身を検索しに行っています。
中身の情報は、
divごとに行を分け、
列方向に、情報を書き出していっています。

まとめ

このコードを覚えることで、
様々なサイトの商品情報などを簡単にまとめることができます。

ぜひ一度試してみてください。

その他、VBAでIEを動かすために必要な情報をまとめています！！

こちらを参照ください！

【まとめ】VBAでIEを動かすプログラムまとめ！

まだ、あまり確立されていないVBAでIEを動かすプログラムについて、素人ながらまとめてみました！【まとめ】VBAでIEを動かすプログラムまとめ！・VBA(マクロ)でIEを動かしたい！・社内プログラムでIEと連動させたい。・けれど、参考になる...

vba | nujonoa_blog

条件付き書式を一括で消す場合は、「Cells.FormatConditions.Delete」

条件付き書式を一括で消す場合は、「Cells.FormatConditions.Delete」

実は動作が重い条件付き書式

VBA→VBSの変換！VBS→VBAの起動を！

VBA→VBSの変換！VBS→VBAの起動を！

コード

コードの説明

活用方法

【VBA】最終行、最終列を取得する方法3選

【VBA】最終行を取得する方法3選

「Ctrl+↑」「Ctrl+←」を再現

「Ctrl+↓」「Ctrl+→」を再現

最終行(空白はNG)を検出

【VBA】アクティブシートを特定のフォルダに保存、アップロードする方法

【VBA】アクティブシートを特定のフォルダに保存、アップロードする方法

プログラム紹介

プログラム紹介

右クリックに追加

【VBA】SaveAsでファイルに連番を追加し重複を防ぐ方法

【VBA】SaveAsでファイルに連番を追加し重複を防ぐ方法

プログラムの説明

【VBA】列の英語→数字に変換する方法

【VBA】列の英語(アルファベット)⇒数字に変換する方法

プログラムの説明

≪参考≫数字→アルファベット

【VBA】msgboxで3択を行うには？コピペで簡単。

【VBA】msgboxで3択を行うには？コピペで簡単。

プログラム説明

【VBA】質問、分岐付きmsgbox、コピペで簡単。

【VBA】質問付きmsgbox、コピペで簡単。

プログラム説明

2択のメッセージ

3択のメッセージ

ただのメッセージ

'番外編 INPUTボックス

【VBA】右クリックのメニューにマクロを追加する方法

【VBA】右クリックのメニューにマクロを追加する方法

プログラム説明

メニューの登録と削除

Auto_Open() Auto_Close() との組み合わせ

途中で落ちてしまった時、、

【簡単】VBAとIEでページ内の商品情報(div)を順番にすべて取り出す方法

【簡単】VBAとIEでページ内の商品情報(div)を順番にすべて取り出す方法

コードサンプル

重要な要素を簡単に説明

まとめ

'番外編　INPUTボックス

Auto_Open()　Auto_Close()　との組み合わせ