forループが異なるため、VBAのネストループが機能しません。

Question

私はこれに近づいたと思ったので、コードは整っていない住所の列を通り、別の場所でgoogleの検索URLを生成してから、アドレスのGoogleを引っ張って第3列に書き込みます。

セルの位置を指定しても動作するまでには、カラム内のすべてのURLを1つずつ書き込んでいく必要があります。

は、だから、私はIE.Navigateライン上のオートメーションエラーを取得し、それは動作しません言うまでもなく

「のは、別のループでのgetElementsByClassNameを入れてみましょう」と思いました。

Private Sub CommandButton1_Click() 
Dim IE As Object 

' Create InternetExplorer Object 
Set IE = CreateObject("InternetExplorer.Application") 

' You can uncoment Next line To see form results 
IE.Visible = False 

'START LOOP 
' URL to get data from 
For r = 2 To 3 
    IE.navigate Sheets("Sheet1").Cells(r, "A").Value 

    Do While IE.Busy 
    Application.Wait DateAdd("s", 1, Now) 
    Loop 

    Dim dd As String, c 
    ' Runs loops to look for the value within the classname, if classname alternates it will change the element, if null it will exit. 
     For Each c In Array("vk_sh vk_bk", "_Xbe") 
      On Error Resume Next 
      dd = IE.document.getElementsByClassName(c)(0).innerText 
      On Error GoTo 0 
      If Len(dd) > 0 Then Exit For 
     ' Gives a confirmation message and writes the result to a cell 
     Cells(r, "C").Value = dd 
     Next 
Next r 

' /LOOP 

' Show IE 
IE.Visible = False 

' Clean up 
Set IE = Nothing 


End Sub 

注：2から3へ

は、リストはかなり長いので、私は最初のわずか2アドレスでそれをテストしたいです、正しいです。

VBAにもっと堪能な方は、どこに間違っているのか教えていただけますか？

更新：細胞

Answer 1

は、下記の（すなわちだけではなくF8で通過している間）、実行時に私のために働い

Private Sub CommandButton1_Click() 
Dim IE  As Object 
Dim LngRow As Long 
Dim Wksht As Worksheet 
Dim dd  As String 
Dim c  As Variant 

On Error Resume Next 

Set Wksht = ThisWorkbook.Worksheets("Sheet1") 
    Set IE = CreateObject("InternetExplorer.Application") 
     IE.Visible = False 
     'The below will process the all rows in column A 
     For LngRow = 2 To Wksht.Range("A" & Wksht.Rows.Count).End(xlUp).Row 
      If Wksht.Cells(LngRow, 1) <> "" Then 
       IE.Navigate Wksht.Cells(LngRow, 1) 

       'This loops waits for IE to be ready 
       Do Until (IE.Document.ReadyState = "complete") And (Not IE.busy) 
        DoEvents 
       Loop 

       For Each c In Array("vk_sh vk_bk", "_Xbe") 
        dd = "" 
        dd = IE.Document.getElementsByClassName(c)(0).innerText 
        If Len(dd) > 0 Then 
         Wksht.Cells(LngRow, 3) = dd 
         Exit For 
        End If 
       Next 

      End If 
     Next 
     IE.Quit 
    Set IE = Nothing 
Set Wksht = Nothing 

End Sub 

Answer 2

に変更された範囲を、あなたのコードで2つの問題があるようです。私は試していませんが、あなたのコードを見てください

1. 範囲はcell1、cell2と定義されています。セルのアドレスは "A2"、 "A3"なので、コードで行を連結するにはRange（ "A" &r）を実行する必要があります。
2. その後も問題が発生します。 URLにナビゲートすると、ドキュメントが読み込まれるまで待つ必要があります。イベントドリブンのコードを実行するか、ドキュメントの状態が用意された状態になるまでループする必要があります。そうしないと、読み込まれたドキュメントの内容を解析して読み取ることができなくなります。

Answer 3

あなたのコード（およびコーディングスタイル）は鉱山分野です。

この部分Sheets("Sheet1").Range(r, "A").ValueはRangeは、行と列、Cells缶ように2つのparamsを取るカント、エラー1004がスローされます。 Sheets("Sheet1").Cells(r, "A").Value

第2に、Cells(r, "A").Valueが空白/空の場合、ナビゲートするとエラー5が発生します。ナビゲートする前に空でない値を確認してください。 Range(r, "C").Value

ため

同じ範囲の問題、エラー1004は、アドレスを書いていない：それが原因でループのためのあなたの病気の構築、内側の列Cには何も書き込みません。条件が満たされると、セルに値を書き込む前にループから飛び出しています。DDの長さは> 0であれば、それは声明に到達することはありません。ここ

If Len(dd) > 0 Then Exit For 
     'Gives a confirmation message and writes the result to a cell 
     ws.Cells(r,"C").Value = dd 

、へws.Cells(r,"C").Value = dd

変更を：

If Len(dd) > 0 Then 
     'Gives a confirmation message and writes the result to a cell 
     ws.Cells(r,"C").Value= dd 
     Exit For 
     End If 

ボーナス：学び、F8の使用を開始

Answer 4

間違いなく間違いを与える1つの問題は、どのようにレンジを使用しているかです。

あなたのコードの範囲を使用して次の使用する必要があります：

IE.navigate Sheets("Sheet1").Range("A" & r).Value

その後の進路あなたが今と同じよう

Range("C" & r).Value = dd

をプリントアウトする必要がありますコード内に配置してより効率的に使用できるヒントをいくつか紹介します。

Private Sub CommandButton1_Click() 

    Dim IE As Object, r as integer 
    Dim wb as Workbook, ws as Worksheet 
    Dim dd as String, c as Variant, found as Boolean 

    'Create InternetExplorer Object 
    Set IE = CreateObject("InternetExplorer.Application") 
    'create other objects 
    Set wb = ThisWorkbook 
    Set ws = wb.Worksheets("Sheet1") 


    ' You can uncoment Next line To see form results 
    IE.Visible = False 

    'START LOOP 
    ' URL to get data from 
    For r = 2 To 3 
    debug.print ws.Range("A" & r).Value 'see what the url is 
    IE.navigate ws.Range("A" & r).Value 
    Do while IE.ReadyState <> 4: DoEvents: Loop 
    'page loaded. 
    ' Runs loops to look for the value within the classname, if classname alternates it will change the element, if null it will exit 
    found = false 
    For each c in Array("vk_sh vk_bk", "_Xbe") 
     On Error Resume Next 
     dd = IE.document.getElementsByClassName(c)(0).innerText 
     On Error GoTo 0 
     If Len(dd) > 0 Then 
     found = true 
     End If 
     If found Then 
     ws.Range("C" & r).Value = dd 
     dd = "" 'need to set to nothing or it will retain the value. 
     Exit For 
     End If 
    Next c 
    Next r 

    IE.Quit 

'Clean up 
Set IE = Nothing 


End Sub 

あなたが行っていることを行う方法はまだまだありますが、その2つのことを解決してください。あなたのワークブックを投稿するのにもっと助けが必要な場合。

おかげ

編集：私は上記のコードにいくつかの変更を行いました。あなたのループをあまりにも早く脱出しているようです。私はあなたがこれを使用して作業するために提供したURLを取得することができました。コメントで提起された他の問題を含む