Блог

Главная - Вопросы по программированию - Цикл VBA для следующего URL-адреса после 15-20 URL-адресов он начинает переопределять данные в той же ячейке. Почему он начинает помещать данные в неправильную ячейку после некоторого URL-адреса?

Цикл VBA для следующего URL-адреса после 15-20 URL-адресов он начинает переопределять данные в той же ячейке. Почему он начинает помещать данные в неправильную ячейку после некоторого URL-адреса?

#excel #vba

#excel #vba

Вопрос:

Я пытаюсь получить данные из url amp; loop в следующий и поместить в следующий пустой столбец. все работает нормально, но после некоторых URL-адресов данные начинают переопределяться в ячейке seme.

 Sub pulldata()

    Dim tod As String
    Dim IE As Object
    Dim doc As HTMLDocument

    Dim Tbl As HTMLTable, Cel As HTMLTableCell, Rw As HTMLTableRow, Col As HTMLTableCol
    Dim TrgRw As Long, TrgCol As Long

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True

    IE.navigate "https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17amp;instrument=OPTIDXamp;symbol=NIFTYamp;date=25APR2019"

    Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
    Loop

    tod = ThisWorkbook.Sheets("URLList").Range("C2").Value
    Sheets.Add After:=Sheets(Sheets.Count)

    ActiveSheet.Name = tod

    Set doc = IE.document

    For nurl = 2 To 191
        lCol = Range("IV2").End(xlToLeft).Offset(0, 0).Column

        doc.getElementById("underlyStock").Value = ThisWorkbook.Sheets("URLList").Range("A" amp; nurl).Value
        doc.parentWindow.execScript "goBtnClick('stock');", "javascript"

        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        strVal = Range("IV1").End(xlToLeft).Offset(0, 0).Select
        Set Tbl = doc.getElementById("octable")

        TrgRw = 1
        For Each Rw In Tbl.Rows
            TrgCol = 1
            For Each Cel In Rw.Cells
                ThisWorkbook.Sheets(tod).Cells(1, lCol).Cells(TrgRw, TrgCol).Value = Cel.innerText
                TrgCol = TrgCol   Cel.colSpan   ' if Column span is > 1 multiple
            Next Cel
            TrgRw = TrgRw   1
        Next Rw
    Next
End Sub

Почему VBA начинает переопределять после 15-20 URL-адресов.

Комментарии:

1. Возможно, вы захотите выйти TrgRw = 1 за пределы первого For loop . Вне For nurl = 2 To 191 .

Ответ №1:

Я думаю, что лучше собирать данные каждого базового по вертикали ниже пыльника. Попытка определить количество столбцов из последних данных может не всегда давать правильный результат в некоторых случаях (например, производный запрет и т. Д.) Таблица может быть пустой. В противном случае для хранения данных по горизонтали должен использоваться фиксированный размер столбца.

В моих тестовых данных будет показано, как показано ниже введите описание изображения здесь

Код:

 Sub pulldata2()
    Dim tod As String, UnderLay As String
    Dim IE As Object
    Dim doc As HTMLDocument

    Dim Tbl As HTMLTable, Cel As HTMLTableCell, Rw As HTMLTableRow, Col As HTMLTableCol
    Dim TrgRw As Long, TrgCol As Long


    tod = ThisWorkbook.Sheets("URLList").Range("C2").Value   'C2 must have proper sheet name
    have = False
    For Each sht In ThisWorkbook.Sheets
        If sht.Name = tod Then
        have = True
        Exit For
        End If
    Next sht

    If have = False Then
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = tod
    Else
    If MsgBox("Sheet " amp; tod amp; " already exists Overwrite Data?", vbYesNo) = vbNo Then Exit Sub
    End If


    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.navigate "https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17amp;instrument=OPTIDXamp;symbol=NIFTYamp;date=25APR2019"

        Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
        Loop

    Set doc = IE.document

    TrgRw = 1
    For Nurl = 2 To 191

        UnderLay = ThisWorkbook.Sheets("URLList").Range("A" amp; Nurl).Value
        doc.getElementById("underlyStock").Value = UnderLay
        doc.parentWindow.execScript "goBtnClick('stock');", "javascript"

        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        'strVal = Range("IV1").End(xlToLeft).Offset(0, 0).Select
        Set Tbl = doc.getElementById("octable")

        ThisWorkbook.Sheets(tod).Cells(TrgRw, 1).Value = UnderLay  'keep as per your requirement
        ThisWorkbook.Sheets(tod).Cells(TrgRw, 1).Font.Size = 20
        ThisWorkbook.Sheets(tod).Cells(TrgRw, 1).Font.Bold = True
        ThisWorkbook.Sheets(tod).Cells(TrgRw, 1).Select
        TrgRw = TrgRw   1


        For Each Rw In Tbl.Rows
            TrgCol = 1
            For Each Cel In Rw.Cells
                ThisWorkbook.Sheets(tod).Cells(TrgRw, TrgCol).Value = Cel.innerText
                TrgCol = TrgCol   Cel.colSpan   ' if Column span is > 1 multiple
            Next Cel
            TrgRw = TrgRw   1
        Next Rw

    TrgRw = TrgRw   1
    Next Nurl
End Sub

РЕДАКТИРОВАТЬ: если предпочтительна горизонтальная цель, я изменяю последний раздел кода следующим образом:

 Set doc = IE.document

Dim ColOff As Long

For Nurl = 2 To 191
ColOff = (Nurl - 2) * 26
TrgRw = 1
    UnderLay = ThisWorkbook.Sheets("URLList").Range("A" amp; Nurl).Value
    doc.getElementById("underlyStock").Value = UnderLay
    doc.parentWindow.execScript "goBtnClick('stock');", "javascript"

    Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
    Loop

    'strVal = Range("IV1").End(xlToLeft).Offset(0, 0).Select
    Set Tbl = doc.getElementById("octable")

    ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff   1).Value = UnderLay
    ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff   1).Font.Size = 20
    ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff   1).Font.Bold = True
    ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff   1).Select
    TrgRw = TrgRw   1


    For Each Rw In Tbl.Rows
        TrgCol = 1
        For Each Cel In Rw.Cells
            ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff   TrgCol).Value = Cel.innerText
            TrgCol = TrgCol   Cel.colSpan   ' if Column span is > 1 multiple
        Next Cel
        TrgRw = TrgRw   1
    Next Rw

TrgRw = TrgRw   1
Next Nurl

Комментарии:

1. Слов недостаточно, работает отлично. @Ahmed AU sir большое вам спасибо. Только немногие великие личности могут помочь, как вы, сэр, еще раз спасибо, сэр.

Ответ №2:

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

 Sub pulldata()
    Dim tod As String
    Dim IE As Object
    Dim doc As HTMLDocument
    Dim Tbl As HTMLTable, Cel As HTMLTableCell, Rw As HTMLTableRow, Col As HTMLTableCol
    Dim TrgRw As Long, TrgCol As Long
    Dim wk As Workbook
    Set wk = ThisWrokbook
    Set IE = CreateObject("InternetExplorer.Application")

    IE.Visible = True
    IE.navigate "https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17amp;instrument=OPTIDXamp;symbol=NIFTYamp;date=25APR2019"

    Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
    Loop

    tod = wk.Sheets("URLList").Range("C2").Value
    wk.Sheets.Add After:=wk.Sheets(wk.Sheets.Count)
    wk.Worksheets(wk.Sheets.Count).Name = tod
    Set doc = IE.document
    TrgRw = 1

    For nurl = 2 To 191
        lCol = wk.Sheets(tod).Range("IV2").End(xlToLeft).Offset(0, 0).Column
        doc.getElementById("underlyStock").Value = wk.Sheets("URLList").Range("A" amp; nurl).Value
        doc.parentWindow.execScript "goBtnClick('stock');", "javascript"

        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        strVal = wk.Sheets(tod).Range("IV1").End(xlToLeft).Offset(0, 0).Select
        Set Tbl = doc.getElementById("octable")

        For Each Rw In Tbl.Rows
            TrgCol = 1
            For Each Cel In Rw.Cells
                wk.Sheets(tod).Cells(TrgRw, TrgCol).Value = Cel.innerText
                TrgCol = TrgCol   Cel.colSpan   ' if Column span is > 1 multiple
            Next Cel
            TrgRw = TrgRw   1
        Next Rw
    Next
End Sub

Комментарии:

1. Он получает только данные 1-го URL-адреса, даже переходит к следующему URL-адресу, но не записывает данные на листе.

2. Останавливается ли он после перехода ко второму URL-адресу или переходит к следующему без добавления каких-либо данных после первого?

3. он переходит к следующему, не добавляя никаких данных после первого.

4. Попробуйте сейчас, я думаю, что ошибка была в последнем цикле for для начала. Это ваша исходная строка: ThisWorkbook.Sheets(tod).Cells(1, lCol).Cells(TrgRw, TrgCol).Value = Cel.innerText Есть две ячейки. Вложенные ячейки. Давайте посмотрим, работает ли это.

5. Сэр, если мы это сделаем, мы не сможем поместить данные в следующий пустой столбец. Теперь он начинает переопределять данные в начальной ячейке.

Метки: