0

我从一个网站收集了这个 vba 代码。它应该从网页中获取数据。但有时如果我为它相应地获取数据的内容和位置写入值，有时它不会。没有错误或任何东西。任何人都请帮我解决这个问题。我在下面给出我的代码：

Sub test()
Dim eRow As Long
Dim ele As Object
Set sht = Sheets("Sheet1")
RowCount = 1
sht.Range("A" & RowCount) = "Title"
sht.Range("B" & RowCount) = "Company"
sht.Range("C" & RowCount) = "Location"
sht.Range("D" & RowCount) = "Description"

eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Set objIE = CreateObject("InternetExplorer.Application")

myjobtype = InputBox("Enter type of job eg. sales, administration")
myzip = InputBox("Enter zipcode of area where you wish to work")

With objIE
.Visible = True
.navigate "http://www.jobs.com/"
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
Set what = .document.getElementsByName("q")
what.Item(0).Value = myjobtype
Set zipcode = .document.getElementsByName("where")
zipcode.Item(0).Value = myzip
.document.getElementById("JobsButton").Click
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
For Each ele In .document.all
Select Case ele.classname
Case "Result"
RowCount = RowCount + 1
Case "Title"
sht.Range("A" & RowCount) = ele.innertext
Case "Company"
sht.Range("B" & RowCount) = ele.innertext
Case "Location"
sht.Range("C" & RowCount) = ele.innertext
Case "Description"
sht.Range("D" & RowCount) = ele.innertext
End Select
Next ele
End With
Macro1
Set objIE = Nothing
End Sub

此代码用于对齐列：

Sub Macro1()
'
' Macro1 Macro
' Formatting imported data
'
'
Columns("A:D").Select
Selection.Columns.AutoFit
With Selection
.VerticalAlignment = xlTop
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("D1").Select
Columns("D:D").ColumnWidth = 50
Columns("A:D").Select
Selection.Rows.AutoFit
End Sub
4

1 回答 1

1

干得好。

工作类型示例
：会计
邮政编码：94551

Sub GetData()

    Dim eRow As Long
    Dim html As Object, ele As Object, xmlHttp As Object
    Dim URL As String, myjobtype As String, myzip As String

    Set sht = Sheets("Sheet1")
    RowCount = 1
    sht.Range("A" & RowCount) = "Title"
    sht.Range("B" & RowCount) = "Company"
    sht.Range("C" & RowCount) = "Location"
    sht.Range("D" & RowCount) = "Description"

    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    myjobtype = InputBox("Enter type of job eg. sales, administration")
    myzip = InputBox("Enter zipcode of area where you wish to work")


    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")

    URL = "http://jobs.com/search?where=" & myzip & "&q=" & myjobtype & "&rnd=" & WorksheetFunction.RandBetween(1, 1000)

    xmlHttp.Open "GET", URL, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send



    Set html = CreateObject("htmlfile")
    html.body.innerHTML = xmlHttp.ResponseText

    For Each ele In html.all
        Select Case ele.classname
        Case "Result"
            RowCount = RowCount + 1
        Case "Title"
            sht.Range("A" & RowCount) = ele.innertext
        Case "Company"
            sht.Range("B" & RowCount) = ele.innertext
        Case "Location"
            sht.Range("C" & RowCount) = ele.innertext
        Case "Description"
            sht.Range("D" & RowCount) = ele.innertext
        End Select
    Next ele

    Macro1
End Sub

Sub Macro1()
'
' Macro1 Macro
' Formatting imported data
'
'
    Columns("A:D").Select
    Selection.Columns.AutoFit
    With Selection
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("D1").Select
    Columns("D:D").ColumnWidth = 50
    Columns("A:D").Select
    Selection.Rows.AutoFit
End Sub
于 2013-07-16T01:58:19.627 回答