Вложенная петля в VBA не работает, из-за разных циклов?

Question

Итак, я думал, что я приблизился к этому, код проходит через столбец нерафинированных адресов, генерирует URL-адрес поискового запроса в другом, а затем тянет адрес, который Google записывает в третий столбец.

Прежде чем я смог заставить его работать, если я указал местоположение ячейки, я хочу, чтобы он работал, опуская каждый URL-адрес в столбце и записывая адрес один за другим.

Так я думал, что «давайте поставить getElementsByClassName в другую петлю»

Само собой разумеется это не работает, я получаю ошибку автоматизации на линии IE.Navigate.

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 будет выдавать ошибку 1004, Range не может принимать два параметра как строки и столбцы, Cells может. Измените его на: Sheets("Sheet1").Cells(r, "A").Value

Во-вторых, если Cells(r, "A").Value пуст/пуст, навигатор выдаст ошибку. 5. Перед перемещением проверьте наличие непустого значения.

Тот же вопрос диапазона, ошибка 1004 для Range(r, "C").Value

Не писать адрес: Он не будет ничего в колонке C писать из ваших больных построен внутреннего цикла. Когда условие выполняется, вы выпрыгиваете из цикла перед записью значения в ячейках.

Здесь

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

если длина ДД> 0 она никогда не достигнет заявление, 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

Одна из проблем, которая определенно даст вам ошибку, - это то, как вы используете диапазон.

При использовании диапазона для кода вам нужно будет использовать следующее:

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 

Есть определенно больше способов сделать то, что вам нужно, но исправить эти две вещи. Если вам нужна дополнительная помощь, разместите свою книгу.

Благодаря

EDIT: Я сделал некоторые изменения в коде выше. Похоже, что вы, возможно, слишком быстро выходили из своей петли. Я смог получить URL-адреса, которые вы предоставили для работы, используя это.