縦に取得するのを横にする＆最後に取得したところから

質問

下記のマクロで、A1の語句をGoogle検索して、
上位５位のタイトル・URLをA2～A11へ記入できます。

そのA1に語句、A2～A11に上位５位というのを、
A1に語句、B1～K1に上位５位という風に変更したいです。

A1（語句）｜A2（タイトル）｜A3（URL）｜

↓

A1（語句）｜B1（タイトル）｜C1（URL）｜

という感じです。

もう一つ、
途中でロボットでない証明のクリックがあります。
そのため、マクロを止めざるおえないです。

改めて、マクロを再開する時に、
最後に取得した語句から始めるようにしたいです。

これらは、どのようなマクロの記述になるでしょうか？

EXCEL２０１６です。
よろしくお願いいたします。

'//標準モジュール
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Dim objIE As SHDocVw.InternetExplorer '参照設定 Microsoft Internet Contorls
Dim oHTML As HTMLDocument '参照設定 Microsoft HTML Object Library
Sub Main()
　Dim c As Range
　Dim enSrTxt As String
　Dim counter As Long
　On Error GoTo ErrHandler
　Const BASEURL As String = "https://www.google.co.jp/search?q="
　With ActiveSheet
　　Set objIE = Nothing
　　For Each c In .Range("A1", .Cells(1, Columns.Count).End(xlToLeft))
　　　If c.Value <> "" Then
　　　　If c.Value Like "*[ぁ-龠]*" Then
　　　　　enSrTxt = EnUtf8(c.Value)
　　　　Else
　　　　　enSrTxt = c.Value
　　　　End If
　　　　Call getIE(BASEURL & enSrTxt)
　　　　'Application.Wait TimeSerial(0, 0, 10) '遅くしていた元凶
　　　　Sleep 500
　　　　counter = counter + 1
　　　End If
　　Next c
　End With
ErrHandler:
　If Err <> 0 Then
　　MsgBox Err.Description
　End If
End Sub

Sub getIE(ByVal strURL As String)
　Dim cnt As Long
　Dim cl As Object
　Dim c As Range
　Dim nm As Long
　Set oHTML = New HTMLDocument
　If objIE Is Nothing Then
　　Set objIE = New SHDocVw.InternetExplorer
　End If

　Set c = Cells(2, Columns.Count).End(xlToLeft) '二行目で計る
　If c.Value <> "" Then nm = c.Column + 1 Else nm = c.Column

　With objIE
　　.Visible = True
　　.navigate strURL
　　Do While .Busy Or .readyState <> 4: DoEvents: Loop
　　Set oHTML = .document
　End With

　　Call outputLog(oHTML, nm)
　　Set cl = objIE.document.getElementsByClassName("csb ch")
　　cl(1).Click
　　DoEvents
　　Sleep 500
　　Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
　　Set oHTML = objIE.document

　Cells(1, nm).EntireColumn.AutoFit
　Application.ScreenUpdating = True

End Sub
Sub outputLog(oHTML As HTMLDocument, nm As Long)
　Dim buf As Variant
　Dim j As Long, i As Long, k As Long
　Dim gLinks As Object
　Dim mTitle As Variant
　Dim cnt As Long
　j = Cells(Rows.Count, nm).End(xlUp).Row + 1

　With oHTML
　 Set mTitle = oHTML.getElementsByClassName("LC20lb")
　　Set gLinks = oHTML.getElementsByClassName("TbwUpd")
　　If gLinks.Length > 0 Then
　　 If (gLinks.Length - 1) > 4 Then cnt = 4 Else cnt = gLinks.Length - 1
　　　For i = 0 To cnt '' 5コまで、
　　　　Cells(j, nm).Value = mTitle(i).innerText
　　　　buf = gLinks(i).ParentNode.href
　　　　If InStr(1, buf, "%") > k Then buf = DecodeUTF8(buf)
　　　　Cells(j + 1, nm).Value = buf
　　　　Cells(j + 1, nm).Font.ColorIndex = 4 'フォントの色
　　　　j = j + 2

　　　　buf = ""
　　　Next
　　End If
　End With
End Sub

Private Function EnUtf8(ByRef strSource As String) As String
　'Encode
　Dim objSC As Object
　Set objSC = CreateObject("ScriptControl")
　objSC.Language = "Jscript"
　EnUtf8 = objSC.CodeObject.encodeURIComponent(strSource)
　Set objSC = Nothing
End Function

Private Function DecodeUTF8(ByVal strSearch As String)
　'Decord
　If strSearch = "" Then Exit Function
　With CreateObject("ScriptControl")
　　.Language = "JScript"
　　With .CodeObject
　　　DecodeUTF8 = .decodeURI(strSearch)
　　End With
　End With
End Function

回答No.1

HohoPapa

>途中でロボットでない証明のクリックがあります
これがよくわかりませんし、当方では再現できないので、
出力レイアウトの変更と
>改めて、マクロを再開する時に、
>最後に取得した語句から始めるようにしたいです。
の対応をしてみました。

Option Explicit

'//標準モジュール
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
　 Dim objIE As SHDocVw.InternetExplorer '参照設定 Microsoft Internet Contorls
　 Dim oHTML As HTMLDocument '参照設定 Microsoft HTML Object Library

'//----------------------
Sub Main()
　Dim enSrTxt As String
　Dim CntR As Long
　Dim counter As Long
　Const BASEURL As String = "https://www.google.co.jp/search?q="

　On Error GoTo ErrHandler
　With ActiveSheet
　　Set objIE = Nothing
　　counter = 0
　　If .Cells(1, 2).Value <> "" Then
　　　CntR = .Cells(Rows.Count, 2).End(xlUp).Row + 1
　　Else
　　　CntR = 1
　　End If

　　Do
　　　If .Cells(CntR, 1).Value = "" Then Exit Do
　　　If .Cells(CntR, 1).Value Like "*[ぁ-龠]*" Then
　　　　enSrTxt = EnUtf8(.Cells(CntR, 1).Value)
　　　Else
　　　　enSrTxt = .Cells(CntR, 1).Value
　　　End If
　　　Call getIE(BASEURL & enSrTxt, CntR)
　　　'Application.Wait TimeSerial(0, 0, 10) '遅くしていた元凶
　　　Sleep 500
　　　counter = counter + 1
　　　CntR = CntR + 1
　　Loop
　　'.Columns("A:K").EntireColumn.AutoFit
　　'MsgBox Format(counter, "0") & "件完了"
　End With

ErrHandler:
　If Err <> 0 Then
　　MsgBox Err.Description
　End If
End Sub

'//----------------------
Sub getIE(ByVal strURL As String, RowNum As Long)
　Dim cnt As Long
　Dim cl As Object
　Set oHTML = New HTMLDocument
　If objIE Is Nothing Then
　　Set objIE = New SHDocVw.InternetExplorer
　End If

　With objIE
　　.Visible = True
　　.navigate strURL
　　Do While .Busy Or .readyState <> 4: DoEvents: Loop
　　Set oHTML = .document
　End With

　Call outputLog(oHTML, RowNum)
　Set cl = objIE.document.getElementsByClassName("csb ch")
　cl(1).Click
　DoEvents
　Sleep 500
　Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
　Set oHTML = objIE.document

　Application.ScreenUpdating = True

End Sub

'//----------------------
Sub outputLog(oHTML As HTMLDocument, RowNum As Long)
　Dim buf As Variant
　Dim i As Long, k As Long
　Dim gLinks As Object
　Dim mTitle As Variant
　Dim cnt As Long

　With oHTML
　　Set mTitle = oHTML.getElementsByClassName("LC20lb")
　　Set gLinks = oHTML.getElementsByClassName("TbwUpd")
　　If gLinks.Length > 0 Then
　　　If (gLinks.Length - 1) > 4 Then cnt = 4 Else cnt = gLinks.Length - 1
　　　For i = 0 To cnt '' 5コまで、
　　　　ActiveSheet.Cells(RowNum, i * 2 + 2).Value = mTitle(i).innerText
　　　　buf = gLinks(i).ParentNode.href
　　　　If InStr(1, buf, "%") > k Then buf = DecodeUTF8(buf)
　　　　ActiveSheet.Cells(RowNum, i * 2 + 3).Value = buf
　　　　ActiveSheet.Cells(RowNum, i * 2 + 3).Font.ColorIndex = 4 'フォントの色
　　　　buf = ""
　　　Next
　　End If
　End With
End Sub

'//----------------------
Private Function EnUtf8(ByRef strSource As String) As String
　'Encode
　Dim objSC As Object
　Set objSC = CreateObject("ScriptControl")
　objSC.Language = "Jscript"
　EnUtf8 = objSC.CodeObject.encodeURIComponent(strSource)
　Set objSC = Nothing
End Function

'//----------------------
Private Function DecodeUTF8(ByVal strSearch As String)
　'Decord
　If strSearch = "" Then Exit Function
　With CreateObject("ScriptControl")
　　.Language = "JScript"
　　With .CodeObject
　　　DecodeUTF8 = .decodeURI(strSearch)
　　End With
　End With
End Function

>途中でロボットでない証明のクリックがあります
画像を添付し、発生タイミングやサイクルなどを加え
質問を改めてもらえば識者からコメントを得られるかもしれません。