我尝试创建一个宏,该宏从网页中提取某些标签的所有单词。分别计算,计数,然后使用Google API查找它给出了多少结果,例如,您好网站:www.hello.com,随后宏应说出具有更多结果的10个单词。尚未结束的事情。
一切正常,就是只有一个变量使我失败。
Cells (i, 5). Value = var1.innerText
出现以下消息
如果您发现可以改进的地方,那就太好了
Sub GrabLastNames()
screenUpdateStatus = Application.ScreenUpdating
statusBarStatus = Application.DisplayStatusBar
calcStatus = Application.Calculation
eventsStatus = Application.EnableEvents
displayPageBreakStatus = ActiveSheet.DisplayPageBreaks
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayAlerts = True
Dim ultima As Long, url As String
Sheets("Sheet1").Select
ultima = Sheets("Sheet1").Range("A10000").End(xlUp).Row
For j = 2 To ultima
Dim objIE As InternetExplorer
Dim ele As Object
Dim y As Integer
url = Sheets("Sheet1").Range("A" & j)
Set objIE = New InternetExplorer
objIE.Visible = False
objIE.navigate url
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
y = 1
For Each ele In objIE.document.getElementsByTagName("p")
Sheets("Sheet2").Range("A" & y).Value = ele.textContent
y = y + 1
Next
For Each ele In objIE.document.getElementsByTagName("h1")
Sheets("Sheet2").Range("A" & y).Value = ele.textContent
y = y + 1
Next
For Each ele In objIE.document.getElementsByTagName("h2")
Sheets("Sheet2").Range("A" & y).Value = ele.textContent
y = y + 1
Next
For Each ele In objIE.document.getElementsByTagName("h3")
Sheets("Sheet2").Range("A" & y).Value = ele.textContent
y = y + 1
Next
For Each ele In objIE.document.getElementsByTagName("a")
Sheets("Sheet2").Range("A" & y).Value = ele.textContent
y = y + 1
Next
objIE.document.getElementsByTagName ("title")
Sheets("Sheet2").Range("A" & y).Value =
objIE.document.getElementsByTagName("title")(0).innerHTML
y = 0
Call palabras
Dim w As Long, jj As Integer
jj = 1
objIE.Quit
Call GetHits(url)
For w = 1 To Sheets("Sheet2").Range("C3").End(xlUp).Row
If Len(Sheets("Sheet2").Range("C" & w)) > 6 Then
If Sheets("Sheet2").Range("C" & w) = "hvordan" Or
Sheets("Sheet2").Range("C" & w) = "cookies" Or Sheets("Sheet2").Range("C" &
w) =
"Hvordan" _
Or Sheets("Sheet2").Range("C" & w) = "hvorfra" Or
Sheets("Sheet2").Range("C" & w) = "Danmark" Or Sheets("Sheet2").Range("C" &
w) =
"Velkommen" Then
Else
Sheets("Sheet1").Cells(j, 1 + jj) = Sheets("Sheet2").Range("C" & w)
jj = jj + 1
If jj = 11 Then
Exit For
End If
End If
End If
Next w
Dim ult As Long
ult = Sheets("Sheet2").Range("A10000").End(xlUp).Row
Sheets("Sheet1").Cells(j, 1 + jj) = Sheets("Sheet2").Range("A" & ult)
Sheets("Sheet2").Cells.Delete
Next j
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = True
Application.Calculation = calcState
Application.EnableEvents = eventsState
ActiveSheet.DisplayPageBreaks = displayPageBreaksState
End Sub
Sub palabras()
Sheets("Sheet2").Select
ultima = Sheets("Sheet2").Range("A10000").End(xlUp).Row
For i = 1 To ultima
'Do While Sheets("Sheet2").Range("A" & i).Value <> ""
tope = Len(Sheets("Sheet2").Range("A" & i))
Final = ""
For x = 1 To tope + 1
extrae = Mid(Sheets("Sheet2").Range("A" & i), x, 1)
If extrae = "" Then
Final = Final & "," & lista
lista = ""
End If
If extrae = " " Then
Final = Final & "," & lista
lista = ""
End If
lista = lista & extrae
Next
Sheets("Sheet2").Select
Range("A" & i).Offset(1, 0).Select
Final = Replace(Final, " ", "")
Final = Mid(Final, 2, Len(Final) - 1)
Final = Split(Final, ",")
ultima22 = Sheets("Sheet2").Range("C10000").End(xlUp).Row
p = 0
For p = 0 To UBound(Final)
Sheets("Sheet2").Range("C" & p + ultima22 + 1).Value = Final(p)
Next
Next i
ultima222 = Sheets("Sheet2").Range("C10000").End(xlUp).Row
For g = 1 To ultima222
Sheets("Sheet2").Range("D" & g).Value =
Application.WorksheetFunction.CountIf(Columns("C"),
Sheets("Sheet2").Range("C" & g))
Next g
Sheets("Sheet2").Range("C1:D" &
Sheets("Sheet2").Range("c65000").End(xlUp).Row).Sort
key1:=Sheets("Sheet2").Range("D1"), order1:=xlDescending, Header:=xlNo,
ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Range("C1:D10000").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlNo
End Sub
Sub GetHits(ByVal url As String)
screenUpdateStatus = Application.ScreenUpdating
statusBarStatus = Application.DisplayStatusBar
calcStatus = Application.Calculation
eventsStatus = Application.EnableEvents
displayPageBreakStatus = ActiveSheet.DisplayPageBreaks
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayAlerts = True
Dim url1 As String, lastRow As Long, XMLHTTP As Object, html As Object,
objResultDiv As Object, objH3 As Object, link As Object
Dim start_time As Date, end_time As Date, var As String, var1 As Object, dato
As String
lastRow = Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Row
start_time = Time
url = Right(url, Len(url) - 4)
If Len(dato) = 3 Then
Else
For i = 1 To lastRow
dato = Sheets("Sheet2").Cells(i, 3).Value
url1 = "https://www.google.com/search?q=" & dato & " site : " & url & " &
Rnd = " & WorksheetFunction.RandBetween(1, 10000)
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
XMLHTTP.Open "GET", url1, False
XMLHTTP.setRequestHeader "Content-Type", "text/xml"
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1;
rv:25.0) Gecko/20100101 Firefox/25.0"
XMLHTTP.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = XMLHTTP.responseText
Set objResultDiv = html.getElementById("rso")
Set var1 = html.getElementById("resultStats")
'If var1.innerText = "" Then
'Else
Cells(i, 5).Value = var1.innerText
Cells(i, 6).Value = "https://www.google.com/search?q=" & Cells(i, 1) & "
site : " & url & " & " & Rnd = " & WorksheetFunction.RandBetween(1, 10000)"
'End If
'DoEvents
Next
End If
end_time = Time
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = True
Application.Calculation = calcState
Application.EnableEvents = eventsState
ActiveSheet.DisplayPageBreaks = displayPageBreaksState
End Sub