VBA разделить строку и l oop медленно - PullRequest
0 голосов
/ 04 февраля 2020

Я очищаю таблицу веб-сайта и получаю результат этой таблицы в таблице Excel:

Таким образом, для каждого элемента tr на веб-сайте я запускаю l oop, например:

For Each tr In trAll
        count = count + 1
        Set tdAll = tr.getElementsByTagName("td")
        For i = 0 To tdAll.Length - 2
            If i = 0 Then
                qryString = tdAll(i).innerText
            Else

                qryString = qryString & "** " & tdAll(i).innerText
            End If
        Next i

       Call PopulateSheet(count, qryString)

     Next

Я вставляю случайный деилиметр, такой как **, между каждым столбцом и отправляю строку строки в качестве аргумента функции populateSheet function

    Function PopulateSheet(i As Long, csv As String)

        With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        End With

        Dim objXLSheet As Worksheet, strFile As String
        Dim k As Long
        Dim columnName As String


        Set objXLSheet = ActiveWorkbook.Sheets("Sheet1") 'set to current worksheet name



        'Write Title
        objXLSheet.Range("A1") = "My Report"
        objXLSheet.Range("A1").Font.Size = 16
        objXLSheet.Range("A1").Font.Bold = True
        objXLSheet.Range("A1").WrapText = False




        If csv <> "" Then
            For k = 0 To UBound(Split(csv, "**"))
                  DoEvents
                objXLSheet.Range(GetColumnName(k) & i) = Split(csv, "**")(k)
            Next k

            'insert Vlookup formula in the final column
                    'If it is a locaiton number
            'objXLSheet.Range(GetColumnName(UBound(Split(csv, ",")) + 1) & i) = "=IFERROR(VLOOKUP(TRIM(D" & i & "),tblMain,1,FALSE),""NOT FOUND"")"


           ' objXLSheet.Range(GetColumnName(UBound(Split(csv, ",")) + 1) & i) = "=IF(TRIM(D12)<>"",IF(IFERROR(VLOOKUP(TRIM(D12),tblMain,1,FALSE),"NF") = "NF","NOT FOUND",""),"")"


            columnName = GetColumnName(UBound(Split(csv, "**")) + 1) & i

            objXLSheet.Range(columnName) = "=IF(TRIM(D" & i & ") <> """",IF(IFERROR(VLOOKUP(TRIM(D" & i & "),tblMain,1,FALSE),""NF"") = ""NF"",""NOT FOUND"",""""),"""")"
            'objXLSheet.Range(GetColumnName(UBound(Split(csv, ",")) + 1) & i) = "=IF(IFERROR(VLOOKUP(TRIM(D" & i & "),tblMain,1,FALSE),""NF"") = ""NF"",""NOT FOUND"","""")"




              If objXLSheet.Range(columnName).Value = "NOT FOUND" Then
                objXLSheet.Range("A" & i & ":" & columnName).Interior.ColorIndex = 3
                objXLSheet.Range("A" & i & ":" & columnName).Font.Color = vbWhite
              Else
                objXLSheet.Range("A" & i & ":" & columnName).Interior.ColorIndex = 2
                objXLSheet.Range("A" & i & ":" & columnName).Font.Color = vbBlack
              End If



            'Absolute reference is really slow so commenting this out
              'objXLSheet.Range(GetColumnName(UBound(Split(csv, ",")) + 1) & i).Select
    'ActiveCell.Formula = "=IF(IFERROR(VLOOKUP(TRIM(INDIRECT(""D""&ROW())),tblMain,1,FALSE), ""NF"")= ""NF"", ""NOT FOUND"", """")"



        End If


        With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

        'objXLSheet.Range (GetColumnName(x) & curRow)

    End Function


Function GetColumnName(x As Long) As String
    Dim intPre As Long
    If x >= 26 Then
        intPre = x \ 26
        GetColumnName = Chr(Asc("A") + intPre - 1) & Chr(Asc("A") + (x Mod 26))
    Else
        GetColumnName = Chr(Asc("A") + x)
    End If
End Function

Как видите, я также вставляю Формула vblookup, которая проверяет наличие всех значений в другой таблице.

Это, однако, занимает около 30-40 секунд для примерно 300 строк. Я добавил:

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    End With

, глядя на другие ответы из stackoverflow, но это не очень помогло.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...