getElementByID(“id”)

getElementByID(“id”)・・・要素のIDを指定して単一の要素を取得
getElementsByName(“name”)・・・要素のNameを指定して単一の要素を取得
getElementsByTagName(“タグ名”)・・・要素のタグ名を指定して複数要素を取得
getElementsByTagName(“タグ名”)(n)・・・要素のタグ名を指定して複数要素の中からn番目の要素を取得
getElementsByClassName(“クラス名”)・・・要素のクラス名を指定して複数要素を取得
getElementsByClassName(“クラス名”)(n)・・・要素のクラス名を指定して複数要素の中からn番目の要素を取得
querySelector(“CSSセレクタ”)・・・CSSセレクタで要素を指定して複数要素の中から1番目の要素を取得
querySelectorAll(“CSSセレクタ”)・・・CSSセレクタで要素を指定して複数要素を取得
    Dim search_result_list
    Set search_result_list = oIE.Document.querySelectorAll(“.srg .rc”)
Private Sub cmd調査_Click()

    Dim r As Long
    Dim lastRow As Long, lng検索No As Long, lngページ数 As Long
    Dim str検索キー As String

    With Worksheets(sheetName2)
        
        For r = 1 To 5
        
            If .Range("C" & r + 4).Value = "" Then
                Exit Sub
            End If
        
            lng検索No = r
            str検索キー = .Range("B" & r + 4).Value & " " & Replace(.Range("C" & r + 4).Value, "-", " ")
            lngページ数 = 2
    
            'Yahoo!ショッピング検索
            Call set_Yahoo(lng検索No, str検索キー, lngページ数)

            '安値順にソート
            Call sort_Yahoo(lng検索No)

            'Yahoo!ショッピング表示
            Call set_Yahoo結果2(lng検索No, lngページ数)

            '楽天検索
            Call set_Rakuten2(lng検索No, str検索キー, lngページ数)
            
            '安値順にソート
            Call sort_Rakuten(lng検索No)

            '楽天表示
            Call set_Rakuten結果2(lng検索No, lngページ数)
            
        Next
        
    End With
    
    MsgBox "完了"

End Sub

Private Sub CommandButton2_Click()

'    Worksheets(sheetName2).Range("B5:C100").ClearContents
    Worksheets(sheetName2).Range("E5:AN100").ClearContents


End Sub
Sub set_Yahoo(lng検索No As Long, str検索キー As String, lngページ数 As Long)

'######################################################################
'
'           Yahoo!ショッピング内検索
'
'######################################################################

        Dim i As Integer, k As Integer, l As Integer, n As Integer, nn As Integer, t As Integer
        Dim URL_search As String, strP As String, strV As String
        Dim txtInput As HTMLInputTextElement
        
        t = 0
        
        'ブラウザのオープン
        Dim objIE As InternetExplorer
        
        Set objIE = New InternetExplorer
        objIE.Visible = True
        
        'IEで開く
        objIE.Navigate searchURL_Y
        Call IEWait2(objIE)                          '自作関数: IE待機用
        Call WaitFor2(2)                             '自作関数: WaitFor2(t):t秒待機
    
       '検索情報の自動入力
        '検索BOX
        Set txtInput = objIE.document.getElementById("ss_yschsp")
        txtInput.Value = str検索キー
        
        '送信ボタン押下
        Set button = objIE.document.getElementById("ss_srch_btn")
        button.Click
    
        
        Call WaitFor2(2)
        
        '表示ボタンの切り替え(列表示)
'        Set button = objIE.document.querySelector(".Icon--list")
'        button.Click
    
        'サーチ結果のURL取得
        URL_search0 = objIE.document.url
        
        Application.ScreenUpdating = False

        nn = 2 '各シートの2行目から書き出す
        
        For k = 1 To lngページ数     'lngページ数まで検索する
        
            'URLの設定
            If k > 1 Then
                         
                URL_search = URL_search0 & "&b=" & 30 * k - 29
                
            Else
            
                URL_search = URL_search0

            End If
        
            objIE.Navigate URL_search
        
            Call IEWait2(objIE)
            Call WaitFor2(2)
            
            'search_result に検索結果部分をページごとにリストとして格納
            Dim search_result_list
            
            Set search_result_list = objIE.document.querySelectorAll(".LoopList__item")
            
            'search_result の個数分繰り返し処理
            With Worksheets("Y" & lng検索No)
                
                If search_result_list.Length = 0 Then Exit For
            
                For i = 0 To search_result_list.Length - 1
                    If InStr(search_result_list.Item(i).querySelector(".WeRPqEQO_DMj").innerText, "中古") = 0 Then
    
                        .Cells(nn, 1).Value = k
                        .Cells(nn, 2).Value = i + 1
'                        .Cells(nn, 4).Value = search_result_list.Item(i).querySelector(".WeRPqEQO_DMj").innerText  'タイトル
                        .Cells(nn, 3).Value = search_result_list.Item(i).querySelector("a").href   'URL
                        .Cells(nn, 4).Value = search_result_list.Item(i).querySelector("._2RweXo29absZ").innerText  '店名
                        strV = search_result_list.Item(i).querySelector("._3Z3ly613XmPi").innerText   '価格
                        strP = search_result_list.Item(i).querySelector("._2UkNjGl36tm2").innerText   'ポイント
            
                        strV = Replace(strV, ",", "")
                        strV = Replace(strV, "円", "")
                        .Cells(nn, 5).Value = Val(strV)
                        .Cells(nn, 6).Value = Mid(strP, InStr(strP, "(") + 1, InStr(strP, "ポ") - InStr(strP, "(") - 1)

                        t = t + 1
                            
                    End If
            
                    nn = nn + 1
                     
                Next

                
            End With
            
            If t = 0 Then
                Worksheets(sheetName2).Range("E" & r).Value = "見つかりませんでした。"
            End If
        Next

            'IEクローズ
            objIE.Quit
            Set objIE = Nothing
        
        Application.ScreenUpdating = True

End Sub

Sub sort_Yahoo(lng検索No As Long)

'######################################################################
'
'           Yahoo!ショッピング内検索結果を安値でソート
'
'######################################################################
    Dim lastRow As Long

    With Worksheets("Y" & lng検索No)
    
        lastRow = .Cells(Rows.Count, 3).End(xlUp).Row
    
        Call .Range("A2:F" & lastRow).Sort( _
                    Key1:=.Range("E1"), _
                    Order1:=xlAscending)
    
    
    End With
    
End Sub

Sub set_Rakuten(lng検索No As Long, str検索キー As String, lngページ数 As Long)

'######################################################################
'
'                 楽天内検索
'
'######################################################################

        Dim i As Integer, k As Integer, l As Integer, n As Integer, nn As Integer, t As Integer
        Dim URL_search As String, strP As String, strV As String
        
        t = 0
        
        'ブラウザのオープン
        Dim objIE As InternetExplorer
        
        Set objIE = New InternetExplorer
        objIE.Visible = True
        
        'IEで開く
        objIE.Navigate searchURL_R
        Call IEWait2(objIE)                          '自作関数: IE待機用
        Call WaitFor2(2)                             '自作関数: WaitFor2(t):t秒待機

       '検索情報の自動入力
       '検索BOX
        Set txtInput = objIE.document.getElementById("sitem")
        txtInput.Value = str検索キー
        
        '送信ボタン押下
        Set button = objIE.document.getElementById("searchBtn")
        button.Click
        
        Call WaitFor2(2)
    
        'サーチ結果のURL取得
        URL_search = objIE.document.url
        
        Application.ScreenUpdating = False
        
        nn = 2 '各シートの2行目から書き出す
        
        For k = 1 To lngページ数     'lngページ数まで検索する
            'URLの設定
            If k > 1 Then
                URL_search2 = URL_search & "?p=" & k
            Else
                URL_search2 = URL_search

            End If
            
            On Error Resume Next

            Set objIE = New InternetExplorer
            objIE.Visible = True
            
            objIE.Navigate URL_search2
            

            Call IEWait2(objIE)
            Call WaitFor2(2)
            
            
            'search_result に検索結果部分をページごとにリストとして格納
            Dim search_result_list
            Set search_result_list = objIE.document.querySelectorAll(".searchresultitem")
            
            'search_result の個数分繰り返し処理
            With Worksheets("R" & lng検索No)
            
                If search_result_list.Length = 0 Then Exit For
            
                    For i = 0 To search_result_list.Length - 1
                        If InStr(search_result_list.Item(i).querySelector("h2").innerText, "中古") = 0 Then
                            
                            .Cells(nn, 1).Value = k
                            .Cells(nn, 2).Value = i + 1
                            .Cells(nn, 3).Value = search_result_list.Item(i).querySelector("a").href   'URL
                            .Cells(nn, 4).Value = search_result_list.Item(i).querySelector(".merchant").innerText  '店名
                            strV = search_result_list.Item(i).querySelector(".important").innerText  '価格
                            strP = search_result_list.Item(i).querySelector(".points").innerText  'ポイント
                            
                            strV = Replace(strV, ",", "")
                            strV = Replace(strV, "円", "")
                            .Cells(nn, 5).Value = Val(strV)
                            .Cells(nn, 6).Value = Left(strP, InStr(strP, "ポ") - 1)
                            
                            t = t + 1
                            
                         End If
                         
                         nn = nn + 1
                    Next
                    
            End With
             
        Next

            'IEクローズ
            objIE.Quit
            Set objIE = Nothing
        
        Application.ScreenUpdating = True

'MsgBox "完了"



End Sub

Sub set_Rakuten2(lng検索No As Long, str検索キー As String, lngページ数 As Long)

'######################################################################
'
'                 楽天内検索
'
'######################################################################

        Dim i As Integer, k As Integer, l As Integer, n As Integer, nn As Integer, t As Integer
        Dim URL_search As String, strP As String, strV As String
        Dim txtInput As HTMLInputTextElement
        Dim button As Object
    
        
        t = 0
        
        'ブラウザのオープン
        Dim objIE As InternetExplorer
        
        Set objIE = New InternetExplorer
        objIE.Visible = True
        
        'IEで開く
        objIE.Navigate searchURL_R
        Call IEWait2(objIE)                          '自作関数: IE待機用
        Call WaitFor2(2)                             '自作関数: WaitFor2(t):t秒待機

       '検索情報の自動入力
       '検索BOX
        Set txtInput = objIE.document.getElementById("common-header-search-input")
        txtInput.Value = str検索キー
        
        '送信ボタン押下
        Set button = objIE.document.getElementsByClassName("button--15weO button--uGWy7 undefined")(0)
        button.Click
        
        Call WaitFor2(2)
    
        'サーチ結果のURL取得
        URL_search = objIE.document.url
        
        Application.ScreenUpdating = False
        
        nn = 2 '各シートの2行目から書き出す
        
        For k = 1 To lngページ数     'lngページ数まで検索する
            'URLの設定
            If k > 1 Then
                URL_search2 = URL_search & "?p=" & k
            Else
                URL_search2 = URL_search

            End If
            
            On Error Resume Next

            Set objIE = New InternetExplorer
            objIE.Visible = True
            
            objIE.Navigate URL_search2
            

            Call IEWait2(objIE)
            Call WaitFor2(2)
            
            
            'search_result に検索結果部分をページごとにリストとして格納
            Dim search_result_list
            Set search_result_list = objIE.document.querySelectorAll(".searchresultitem")
            
            'search_result の個数分繰り返し処理
            With Worksheets("R" & lng検索No)
            
                If search_result_list.Length = 0 Then Exit For
            
                    For i = 0 To search_result_list.Length - 1
                        If InStr(search_result_list.Item(i).querySelector("h2").innerText, "中古") = 0 Then
                            
                            .Cells(nn, 1).Value = k
                            .Cells(nn, 2).Value = i + 1
                            .Cells(nn, 3).Value = search_result_list.Item(i).querySelector("a").href   'URL
                            .Cells(nn, 4).Value = search_result_list.Item(i).querySelector(".merchant").innerText  '店名
                            strV = search_result_list.Item(i).querySelector(".important").innerText  '価格
                            strP = search_result_list.Item(i).querySelector(".points").innerText  'ポイント
                            
                            strV = Replace(strV, ",", "")
                            strV = Replace(strV, "円", "")
                            .Cells(nn, 5).Value = Val(strV)
                            .Cells(nn, 6).Value = Left(strP, InStr(strP, "ポ") - 1)
                            
                            t = t + 1
                            
                         End If
                         
                         nn = nn + 1
                    Next
                    
            End With
             
        Next

            'IEクローズ
            objIE.Quit
            Set objIE = Nothing
        
        Application.ScreenUpdating = True

'MsgBox "完了"



End Sub

Sub sort_Rakuten(lng検索No As Long)

'######################################################################
'
'           Rakuten内検索結果を安値でソート
'
'######################################################################
    Dim lastRow As Long

    With Worksheets("R" & lng検索No)
    
        lastRow = .Cells(Rows.Count, 3).End(xlUp).Row
    
        Call .Range("A2:F" & lastRow).Sort( _
                    Key1:=.Range("E1"), _
                    Order1:=xlAscending)
    
    
    End With
    
End Sub

'IE待機用関数
Public Sub IEWait2(ByRef objIE As Object)
    Do While objIE.Busy Or objIE.readyState <> 4
        DoEvents
    Loop
End Sub

't[sec]待機させる関数
Public Sub WaitFor2(ByVal second As Integer)
    Dim futuretime As Date
    futuretime = DateAdd("s", second, Now)
    While Now < futuretime
        DoEvents
    Wend
End Sub


Sub set_Yahoo結果(lng検索No As Long, lngページ数 As Long)

    Dim lng行番号 As Long, i As Long
    Dim lastRow As Long, rowNo As Long, strURL As String
    
    '占有率表示
    With Worksheets("Y" & lng検索No)
    
        lastRow = .Cells(Rows.Count, 3).End(xlUp).Row
        
        lng行番号 = lng検索No + 1
        
        If lastRow > 1 Then
        
            rowNo = .Range("D2:D" & lastRow).Find(str店名, LookAt:=xlWhole).Row
            
            'モダンブルーの表示順位(M列)、価格(N列)、商品URL(O列)
            Worksheets(sheetName).Range("M" & lng行番号).Value = .Range("B" & rowNo).Value
            Worksheets(sheetName).Range("N" & lng行番号).Value = .Range("E" & rowNo).Value
            strURL = .Range("C" & rowNo).Value
            Worksheets(sheetName).Range("O" & lng行番号).Value = strURL
            
            'URLにハイパーリンクをつける
            Dim hyplink  As Hyperlink
            Set hyplink = Worksheets(sheetName).Hyperlinks.Add( _
                                                           Anchor:=Worksheets(sheetName).Range("O" & lng行番号), _
                                                           Address:=strURL)
        
            For i = 2 To 6
               'Q列(価格)、R列(店舗名)、S列(ポイント)
                Worksheets(sheetName).Range("Q" & lng行番号).Value = .Range("E" & i).Value
                Worksheets(sheetName).Range("R" & lng行番号).Value = .Range("D" & i).Value
                Worksheets(sheetName).Range("S" & lng行番号).Value = .Range("F" & i).Value
            
                lng行番号 = lng行番号 + 1
                
            Next i
            
         End If

    End With
    
    
End Sub

Sub set_Yahoo結果2(lng検索No As Long, lngページ数 As Long)

    Dim lng行番号 As Long, i As Long
    Dim lastRow As Long, rowNo As Long, strURL As String, rngA As Range
    
    '占有率表示
    With Worksheets("Y" & lng検索No)
    
        lastRow = .Cells(Rows.Count, 3).End(xlUp).Row
        
        lng行番号 = lng検索No + 4
        
        If lastRow > 1 Then
        
            On Error GoTo myError
            
            Set rngA = .Range("D2:D" & lastRow)
        
            rowNo = rngA.Find(str店名, LookAt:=xlWhole).Row
            
            'モダンブルーの表示順位(M列)、価格(N列)、商品URL(O列)
            Worksheets(sheetName2).Range("W" & lng行番号).Value = .Range("B" & rowNo).Value
            Worksheets(sheetName2).Range("X" & lng行番号).Value = .Range("E" & rowNo).Value
            strURL = .Range("C" & rowNo).Value
            Worksheets(sheetName2).Range("Y" & lng行番号).Value = strURL
            
            'URLにハイパーリンクをつける
            Dim hyplink  As Hyperlink
            Set hyplink = Worksheets(sheetName2).Hyperlinks.Add( _
                                                           Anchor:=Worksheets(sheetName2).Range("Y" & lng行番号), _
                                                           Address:=strURL)
        
            For i = 0 To 4
               'Q列(価格)、R列(店舗名)、S列(ポイント)
                Worksheets(sheetName2).Cells(lng行番号, 26 + i * 3).Value = .Range("E" & i + 2).Value
                Worksheets(sheetName2).Cells(lng行番号, 27 + i * 3).Value = .Range("D" & i + 2).Value
                Worksheets(sheetName2).Cells(lng行番号, 28 + i * 3).Value = .Range("F" & i + 2).Value
                
            Next i
            
         End If

    End With
    
    Exit Sub
    
myError:
    MsgBox "ヤフショの検索結果では、モダンブルーの商品は見つかりません。検索対象の品番を見直すか、検索ページ数を増やしてください。"       '表示されます
    
    
End Sub

Sub set_Rakuten結果(lng検索No As Long, lngページ数 As Long)

    Dim lng行番号 As Long, i As Long
    Dim lastRow As Long, rowNo As Long, strURL As String
    
    '占有率表示
    With Worksheets("R" & lng検索No)
    
        lastRow = .Cells(Rows.Count, 3).End(xlUp).Row
        
        lng行番号 = lng検索No * 5 + 1
        
        If lastRow > 1 Then
        
            rowNo = .Range("D2:D" & lastRow).Find(str店名2, LookAt:=xlWhole).Row
            
            'モダンブルーの表示順位(F列)、価格(G列)、商品URL(H列)
            Worksheets(sheetName).Range("F" & lng行番号).Value = .Range("B" & rowNo).Value
            Worksheets(sheetName).Range("G" & lng行番号).Value = .Range("E" & rowNo).Value
            strURL = .Range("C" & rowNo).Value
            Worksheets(sheetName).Range("H" & lng行番号).Value = strURL
            
            'URLにハイパーリンクをつける
            Dim hyplink  As Hyperlink
            Set hyplink = Worksheets(sheetName).Hyperlinks.Add( _
                                                           Anchor:=Worksheets(sheetName).Range("H" & lng行番号), _
                                                           Address:=strURL)
        
            For i = 2 To 6
               'J列(価格)、K列(店舗名)、L列(ポイント)
                Worksheets(sheetName).Range("J" & lng行番号).Value = .Range("E" & i).Value
                Worksheets(sheetName).Range("K" & lng行番号).Value = .Range("D" & i).Value
                Worksheets(sheetName).Range("L" & lng行番号).Value = .Range("F" & i).Value
            
                lng行番号 = lng行番号 + 1
                
            Next i
            
         End If

    End With
    
End Sub


Sub set_Rakuten結果2(lng検索No As Long, lngページ数 As Long)

    Dim lng行番号 As Long, i As Long
    Dim lastRow As Long, rowNo As Long, strURL As String
    
    '占有率表示
    With Worksheets("R" & lng検索No)
    
        lastRow = .Cells(Rows.Count, 3).End(xlUp).Row
        
        lng行番号 = lng検索No + 4
        
        If lastRow > 1 Then
        
            rowNo = .Range("D2:D" & lastRow).Find(str店名2, LookAt:=xlWhole).Row
            
            'モダンブルーの表示順位(F列)、価格(G列)、商品URL(H列)
            Worksheets(sheetName2).Range("E" & lng行番号).Value = .Range("B" & rowNo).Value
            Worksheets(sheetName2).Range("F" & lng行番号).Value = .Range("E" & rowNo).Value
            strURL = .Range("C" & rowNo).Value
            Worksheets(sheetName2).Range("G" & lng行番号).Value = strURL
            
            'URLにハイパーリンクをつける
            Dim hyplink  As Hyperlink
            Set hyplink = Worksheets(sheetName).Hyperlinks.Add( _
                                                           Anchor:=Worksheets(sheetName2).Range("G" & lng行番号), _
                                                           Address:=strURL)
        

            
            For i = 0 To 4
               '(価格)、(店舗名)、(ポイント)
                Worksheets(sheetName2).Cells(lng行番号, 8 + i * 3).Value = .Range("E" & i + 2).Value
                Worksheets(sheetName2).Cells(lng行番号, 9 + i * 3).Value = .Range("D" & i + 2).Value
                Worksheets(sheetName2).Cells(lng行番号, 10 + i * 3).Value = .Range("F" & i + 2).Value
                
            Next i
            
         End If

    End With
    
End Sub


Public Const searchURL_R = "https://www.rakuten.co.jp/"

Public Const searchURL_Y = "https://shopping.yahoo.co.jp/"

Public Const sheetName = "最安値調査"

Public Const sheetName2 = "改善案"

Public Const str店名 = "モダンブルーYahoo!店"

Public Const str店名2 = " モダンブルー楽天市場店"

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です