Я очищаю таблицу веб-сайта и получаю результат этой таблицы в таблице 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, но это не очень помогло.