Question

我有一个代码，它将从页面中删除我放入A2的任何一个滚动条的所有信息。我分别使用一个vlookup将统计信息放在它旁边的单元格中，然后将其复制并粘贴到另一个区域，这样就不会弄乱vlookup（有点无知，我知道，但不是问题。）

我在A3中有第二个股票代码我想做同样的事情......但我不知道如何正确循环A3的代码。代码目前只为A2做了两次。（这个问题可能与坚持A2的my_page代码行有关？）

无论如何，我只是希望代码吐出一些东西。复制/粘贴我想要的东西。然后转到第二行，吐出网页。复制/粘贴在第一行下面的行中。等等。

有关如何逐行循环的任何建议吗？

Sub Macro1()

    Dim rng As Range
    Dim row As Range
    Dim cell As Range

    Set rng = Range("A2:A3")

    For Each row In rng
        For Each cell In row.Cells

            Range("F4").Select
            my_Page = "http://finance.yahoo.com/q?s=" & Range("A2").Value
            Set IE = CreateObject("InternetExplorer.Application")
            With IE
                .Visible = True
                .Navigate my_Page
                Do Until .ReadyState = 4: DoEvents: Loop
            End With

            Application.EnableEvents = False
            IE.ExecWB 17, 0
            Do Until IE.ReadyState = 4: DoEvents: Loop
            IE.ExecWB 12, 2
            Sheets("Sheet1").PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
            Range("F4").Select

            IE.Quit
            Application.EnableEvents = True

            Range("A2:B2").Select
            Range("B2").Activate
            Selection.Copy
            Range("H2").Select
            Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False

        Next cell
    Next row

End Sub

Answer 1

是的，你的错误在这一行：

my_Page = "http://finance.yahoo.com/q?s=" & Range("A2").Value

试试这个：

my_Page = "http://finance.yahoo.com/q?s=" & Range("A" & rng.row).Value

此外，您可以删除For each cell in row.cells ... Next，因为您从不引用cell

您还必须更改这些内容：

Range("A2:B2").Select
Range("B2").Activate
Selection.Copy
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone_
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

到此：

Range("B" & rng.row).Copy
Range("H" & rng.row).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone_
, SkipBlanks:=False, Transpose:=False
Range("H" & rng.row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

注意：

消除.select会减少代码行数和数量。大大提高了可读性。
强烈建议消除Active*的所有用途，以避免混淆。为工作簿，工作表和工作表声明和分配变量很容易。细胞给他们有意义，清晰和不混淆的名字。比试图找出ActiveSheet之后真正指向12行代码的要好得多。

<强>更新

我讨厌像这样的范围工作，他们伤害了我的头脑。这是基于范围

的简单For...Next循环的变体

Sub Macro1()

Dim rng As Range
Dim i As integer
'Dim cell As Range

Set rng = Range("A2:A3")

For i = rng.row to rng.rows.count
    Range("F4").Select
    my_Page = "http://finance.yahoo.com/q?s=" & Range("A" & i).Value
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .Navigate my_Page
        Do Until .ReadyState = 4: DoEvents: Loop
    End With

    Application.EnableEvents = False
    IE.ExecWB 17, 0
    Do Until IE.ReadyState = 4: DoEvents: Loop
    IE.ExecWB 12, 2
    'NOTE: This will ALWAYS paste into F4 - is that what you want?
    Sheets("Sheet1").PasteSpecial Format:="HTML", link:=False,
    DisplayAsIcon:=False, NoHTMLFormatting:=True

    IE.Quit
    Application.EnableEvents = True

    Range("B"&i).Copy
    Range("H" & i).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    'I believe this is redundant after the line above...
    Range("H" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Next 

End Sub

VBA Webscrape循环

1 个答案: