VBA VBA擦除循环
VBA VBA擦除循环
提问于 2015-04-18 01:32:43
我有一个下面的代码，它将抓取页面的所有信息，无论我放入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回答 1
Stack Overflow用户
发布于 2015-04-18 01:59:03
是的，你的错误在这一行：
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，减少了代码行数并极大地增加了.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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/29705867
复制相关文章
相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号