Question

我有一个成功的Webscrape，它从excel中的A列中提取一个数字并将其输入到网页中。该程序做了一些事情，例如登录用户，单击几个按钮，输入数字，将网页信息复制/粘贴回excel（从bc下面的代码中删除，这对我的问题不是必需的），以及然后遍历下一个数字。这是数字的样子：

我遇到的问题是：结束我想在我将i = 3设置到最后一行的位置之后需要放置一些东西，但是nothign会停止程序。它将仅输入空白数字（即单元格A10），这显然会在网页中显示错误。

Option Explicit

Sub NewScrape()

Dim IE As Object
Dim IeDoc As Object
Dim aInput As Object
Dim eInput As Object
Dim svalue1 As Object
Dim a As Object
Dim b As Object
Dim elems As Object
Dim t As Date
Dim i As Long, lastrow As Long
Dim results As Variant, wkshtnames()
Dim ws As Worksheet, wks As Excel.Worksheet
Dim NewName As String
Dim sheet As Worksheet
Dim duplicate As Boolean

 Const MAXWAIT_sec As Long = 10

Set ws = Sheets("VALUE")

Set IE = CreateObject("InternetExplorer.application")
IE.Visible = True
IE.Navigate ("http://mywebsite.com/")

    Do While IE.busy: DoEvents: Loop

Set IeDoc = IE.document

 'Enters username and password
 With IeDoc
    .forms("signingin").UserName.Value = "userr"
    .forms("signingin").Password.Value = "password"
    .forms("signingin").document.forms(0).submit
End With


  Application.Wait (Now + TimeValue("0:00:03"))

lastrow = ws.Cells(ws.rows.Count, "A").End(xlDown).Row
IE.Visible = True

For i = 3 To lastrow

Set IeDoc = IE.document ' set new page source

t = Timer

Do
    On Error Resume Next
    Set elems = IeDoc.queryselector("input[value=Initiate]")
    On Error GoTo 0
    If Timer - t > MAXWAIT_sec Then
        Exit Do
    End If
Loop While elems Is Nothing

If Not elems Is Nothing Then
    elems.Item.Click
End If

      Application.Wait (Now + TimeValue("0:00:03"))


IeDoc.getElementByID("checkConf").Click


For Each aInput In IeDoc.getElementsbyTagName("input")
     If aInput.getAttribute("value") = "Request" Then
        aInput.Click
        Exit For
    End If
Next aInput


Do While IE.busy: DoEvents: Loop

'Selects history
For Each aInput In IeDoc.getElementsbyTagName("input")
    If aInput.getAttribute("value") = "History" Then
        aInput.Click
        Exit For
    End If
Next aInput


    Set svalue1 = IeDoc.getElementByID("accountNumber")
    svalue1.Value = ws.Cells(i, 1).Value 'takes the  number out and enters


        'presses submit once acct numb is entered
        For Each aInput In IeDoc.getElementsbyTagName("input")
            If aInput.getAttribute("value") = "Submit Request" Then
                aInput.Click
                Exit For
             End If
        Next aInput

IE.Visible = True
Do While (IE.READYSTATE <> 4 Or IE.busy <> False): DoEvents: Loop


'If the worksheet already has been made:
duplicate = False
For Each sheet In ThisWorkbook.Sheets
    If sheet.Name = Range("D10") Then
        MsgBox ("ERROR: This Numb has already been formulated")
        NewName = InputBox("Please Rename:")
        ActiveSheet.Name = NewName
        duplicate = True
            Exit For
    End If
Next sheet

If duplicate = False Then
    ActiveSheet.Name = Range("d10")
    Range("A6").Clear
    ActiveSheet.Protect
End If


        'this navigates back to the page 
    IE.Navigate ("https://mywebsite.com/Default")
    Do While (IE.READYSTATE <> 4 Or IE.busy <> False): DoEvents: Loop
    IE.Visible = True


Next i
    Do While (IE.READYSTATE <> 4 Or IE.busy <> False): DoEvents: Loop
    IE.Visible = True


  End Sub

所以我尝试在Error GoTo 0上添加，我尝试在svalue之后写一行，并说它是否为=“”然后退出等。

Answer 1

更改此

lastrow = ws.Cells(ws.Rows.Count, "A").End(xlDown).Row

收件人

lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

旁注：

使用适当的页面加载等待，您也许可以删除其中一些硬编码的等待

While .busy Or .readystate <> 4: DoEvents: Wend

input元素的每个循环都在寻找特定值，可以使用如下语法重新编写：

.document.querySelector("input[value=Submit Request]").Click '<change value of value attribute

在需要大量单击和导航的情况下，ie.document的工作通常比关闭HTMLDocument变量更安全。

Dim sheetName As String
sheetName = ws.Range("D10").Value
For Each sheet In ThisWorkbook.Worksheets
    If sheet.Name = sheetName Then
        MsgBox "ERROR: This Numb has already been formulated"
        NewName = InputBox("Please Rename:")
        sheet.Name = NewName
        duplicate = True
        Exit For
    End If
Next sheet

这减少了访问工作表以接收Range（“ D10”）值的时间。通过使用显式工作表引用ws前面的ws.Range("D10").Value消除潜在的错误；这应该彻底解决。而且您想在循环中检查sheet.Name而不是Activesheet。

Answer 2

ws.rows.Count将为您计算一张纸中可能的最大行数（超过1,000,000）。然后执行End(xlDown)会尝试往下走，仍然是相同的数字。

有两种方法可以获取正确的行。

如果您可以保证您的数字始终以A3开头，并且从A3到预期的结尾永远没有空格，那么这将起作用 lastrow = ws.Range("A3").end(xlDown).row

或者，如果您有缺口，只需将xlDown更改为xlUp即可从底部开始查找具有QHarr建议值的第一行。

VBA问题，当单元为空时，结束循环

2 个答案: