Страницы: 1
RSS
Пропустить пустые ячейки в цикле For
 
Друзья, помогите!
Не могу никак сделать в макросе так , чтоб переменную url в цикле for пропускал если ячейка пустая или ошибочный url и переходил к следующей строке. Я самоучка, по разным видео и инструкциям сварганил этот код. Не судите строго.
Буду благодарен за помощь



Код
Sub Öåíà_àðòèêóë()
Dim XMLHTTP As Object
Dim url, txt
Dim n&, k&
 
For i = 1 To 200
    url = Cells(i, 21)
    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
 
    XMLHTTP.Open "GET", url
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0............" 
    XMLHTTP.SEND
        If XMLHTTP.Status <> 200 Then
                                
        Else
            txt = XMLHTTP.responseText
            n = InStr(1, txt, "price-block__final-price") + 27
            k = InStr(n, txt, " ")
            Price = Replace(Mid(txt, n, k - n), " ", "")
            Cells(i, 19) = Price
            Txt2 = XMLHTTP.responseText
            n2 = InStr(1, txt, "ProdID") + 11
            k2 = InStr(n2, txt, "  ],")
            art = Replace(Mid(txt, n2, k2 - n2 - 1), " ", "")
            Cells(i, 20) = art

        End If
        
        Next i

End Sub


Изменено: Иван Иванов - 09.12.2021 08:41:13
 
попробуйте так

Код
Sub Test()
    Dim XMLHTTP As Object
    Dim url, txt
    Dim n&, k&
    Dim LastRow As Long
  
    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
    LastRow = Cells(Rows.Count, 21).End(xlUp).Row 'номер последней строки в столбце 21
    For i = 1 To LastRow
        If Cells(i, 21) <> "" Then 'проверяем пустая ячейка или нет
            url = Cells(i, 21)
            XMLHTTP.Open "GET", url
            XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0............"
            XMLHTTP.SEND
            If XMLHTTP.Status <> 200 Then
            Else
                txt = XMLHTTP.responseText
                n = InStr(1, txt, "price-block__final-price") + 27
                k = InStr(n, txt, " ")
                Price = Replace(Mid(txt, n, k - n), " ", "")
                Cells(i, 19) = Price
                Txt2 = XMLHTTP.responseText
                n2 = InStr(1, txt, "ProdID") + 11
                k2 = InStr(n2, txt, "  ],")
                art = Replace(Mid(txt, n2, k2 - n2 - 1), " ", "")
                Cells(i, 20) = art
            End If
        End If
    Next i
 
    MsgBox "Конец", vbInformation, "Конец"
End Sub
 
Что-то типа такого наверное
Скрытый текст
Изменено: Nordheim - 09.12.2021 09:04:13
"Все гениальное просто, а все простое гениально!!!"
 
Спасибо Вам большое!!!Все заработало
Страницы: 1
Наверх