Question

我创建了一个从Web提取数据并在excel中的特定工作表Sheets("Feuil1").Cells(x, x)中打印它的宏，代码完美但问题是：

摘录仅适用于一个值，请参阅If Not itm Is Nothing Then itm.Value = "k20442"

我想要的是改变k20442，例如：

Set Plage = Worksheets("Feuil2").Range("A2", Range("A2").End(xlDown))
count = 1
For Each Cell In Plage
MPNum = Cell.Value
count = count + 1

此行与If Not itm Is Nothing Then itm.Value = MPNum

类似

这意味着当我运行代码时，它使用位于此处Worksheets("Feuil2").Range("A2", Range("A2").End(xlDown)的值进行搜索并在表单1中打印数据

Option Explicit

Sub extrt()

    Dim ws As Worksheet
    Dim IE As Object, elemCollection As Object
    Dim itm As IHTMLElement, oHtml As HTMLDocument
    Dim r As Long, c As Long, t As Long
    Dim doc, tags, tagx, i, ele

    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .navigate ".do?clearBackList=true&CMH_NO_STORING_fromMenu=true"

        While .Busy Or .readyState <> 4: DoEvents: Wend
        'we ensure that the web Page is loaded completely
        Set itm = .document.getElementsByName("searchById")(0)
        If Not itm Is Nothing Then itm.Value = "k20442"
        Set doc = .document

        Set tags = .document.getElementsByTagName("input")

        For Each tagx In tags
            If tagx.src = "http:/mage/button_search.gif" Then tagx.Click
        Next

        'On Error Resume Next  'disable error handling during troubleshooting

        While .Busy Or .readyState <> 4: DoEvents: Wend

        Set oHtml = New HTMLDocument
        oHtml.body.innerHTML = .document.body.innerHTML

    End With

    Set elemCollection = oHtml.getElementsByClassName("TableContent")

    Debug.Print elemCollection.Length
    Debug.Print oHtml.body.innerHTML

    Sheets("Feuil1").Range("A1:AK500").ClearContents

    i = 1
    For Each ele In elemCollection(4).getElementsByTagName("TD")
        Sheets("Feuil1").Cells(4, i) = ele.innerText
        i = i + 1
    Next

    i = 1
    For Each ele In elemCollection(1).getElementsByTagName("TD")
        Sheets("Feuil1").Cells(6, i) = ele.innerText
        i = i + 1
    Next

    For t = 0 To (elemCollection.Length - 1)
        For r = 0 To (elemCollection(t).Rows.Length - 1)
            For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
                Sheets("Feuil1").Cells(r + 2, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
            Next c
        DoEvents
        Next r
    Next t


    IE.Quit

    MsgBox "Done"
End Sub

需要修改的搜索行是

 If Not itm Is Nothing Then itm.Value = "k20442"

，结果就像是sheet1中的一个变量

我希望将它们用于搜索的其他值表位于sheet2

中

我正在使用的库：

1- Microsoft HTML对象库

2-Microsoft Internet Control

3-Microsoft Scripting Runtime

有人可以解雇我吗？

Answer 1

在尝试找到解决方案后，我创建了这个

Dim MPNum As Variant 
Dim lastRow As Variant
Dim d As Long
Dim f As Variant 
lastRow = Worksheets("Feuil2").Cells(Rows.count, "A").End(xlUp).Row  
d = 0
For Each f In Sheets("Feuil2").Range("A1:A" & lastRow).Value
MPNum = f
    d = d + 1
Next f

我更改了这一行：

If Not itm Is Nothing Then itm.Value = MPNum

所以直到这里代码工作得很好:)并进行多次搜索

网络抓取 - 更改变量

1 个答案: