作者：乔山办公网日期：
返回目录：excel表格制作
使用for each遍历抄所选择的单元格即可。
如下代码将选择区百域的单元格输出在立度即窗口。
Sub Get_Data()
Dim myRange As Range
Dim myCell As Range
Set myRange = Application.InputBox("选择区域", Type:=8)
For Each myCell In myRange
Debug.Print myCell.Value
Next
End Sub
比如 你想 把 sheet1 中A1 单元格知 复制给 X变量 那么道
X = sheets("sheet1").range("a1")
比如你又要把 某个内 运算结果 的容变量值 Y 复制给 sheet1的 A1 那么：
sheets("sheet1").range("a1")=Y
'从楼上e799bee5baa6e997aee7ad94e4b893e5b19e365的改一下，使用集合提高效率，其他优化。
Sub MeThee()
Application.ScreenUpdating = False
Dim aFileName$,myPath$
Dim aCollection As New Collection
Dim bCollection As New Collection
myPath = "d:\xxx\" '设置路径
aFileName = Dir(myPath & "*.xls*") '从myPath指定的目录查找excel文件
While aFileName <> "" And Instr(1,aFileName,"$") = 0 Then
With Workbooks.Open(Filename:=myPath & aFileName, ReadOnly:=True) '以只读方式打开工作簿
aCollection.Add .Sheets1.Range("B5") '假如姓名在B5
bCollection.Add .Sheets1.Range("F5") '假如姓名在B5
.Close False '关闭工作簿
End With
f = Dir '查找下一个
Wend
Application.ScreenUpdating = True
End Sub
参考：e69da5e6ba90e799bee5baa6332
Sub A1下载数据()
ReDim A2(1 To 200000, 1 To 15): A = 0
For i = 1 To 5
Sleep 2000 + 1000 * Rnd
With CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "目标网页"
.Open "get", URL, False
.setRequestHeader "Host", "xxxxx"
.Send
Q1 = .responseText
Q1 = Replace(Q1, """", "")
Q1 = Replace(Q1, Chr(9), "")
Q1 = Replace(Q1, Chr(10), "")
Q1 = Replace(Q1, Chr(13), "")
Q1 = Replace(Q1, "=odd>", "=>")
End With
'Sheet1.[A2] = Q1
B1 = Split(Q1, "</tr><tr class=><td>")
For j = 1 To UBound(B1)
B2 = Split(B1(j), "</td>")
B3 = Split(Replace(B2(1), "<td>", ""), ",")
A2(A + 1, 1) = Replace(B2(2), "<td>", "")
A2(A + 1, 2) = Replace(B2(0), "<td>", "")
For K = 0 To 9
A2(A + 1, 3 + K) = B3(K)
Next
A = A + 1
Next
Application.StatusBar = i
Next
MsgBox A
With Sheet1
If .AutoFilterMode = True Then .AutoFilterMode = False
.Rows("2:600000").ClearContents
If A > 0 Then .[A2].Resize(A, 15) = A2
.Rows(1).AutoFilter '数据筛选
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
End With
End Sub