Question

EXCEL的宏如何用VB编写循环

需要用EXCEL的宏完成一个小功能：依次打开100个EXCEL表，并把它们的内容按顺序复制到一个表中。100个EXCEL表名为ORANGE001到ORANGE100。谢谢了！
就是将100个独立的EXCEL文件（每个独立的EXCEL文件中包含两列数据）按 列 的顺序导入到一个新的EXCEL文件的第一张工作表中去

Answer 1

我可以帮你，但是程序可能需要根据你的需求做更改.

Sub 自动汇总()
'功能：合并某文件下所有Excel工作簿中的第一个工作表
'使用：将要合并的工作簿拷贝到某文件夹下，新建一个工作簿后执行该宏
Dim WBName As String '汇总工作簿名称
Dim WBCurrent As String '当前正在合并的工作簿
Dim i As Integer
Dim FileToOpen As Variant '选定的文件列表
'显示选择文件对话框，使用Ctrl或Shief键选取多个工作簿
FileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls", , "请选择要合并的工作簿", , True)
'如果没有选择文件则退出
If IsArray(FileToOpen) = 0 Then
MsgBox "没有选择文件"
Exit Sub
End If
'不显示合并的过程
Application.ScreenUpdating = False
WBName = ActiveWorkbook.Name
'逐个合并工作簿
For i = 1 To UBound(FileToOpen)
'打开一个工作簿
Workbooks.Open Filename:=FileToOpen(i)
WBCurrent = ActiveWorkbook.Name
'将该工作簿复制到汇总工作簿
Workbooks(WBName).Sheets(1).Cells(1, i) = WBCurrent

'合并后关闭该工作簿
ActiveWorkbook.Save
Workbooks(WBCurrent).Close
Next i
Application.ScreenUpdating = True
End Sub

然后全部向下拖拽填充

Answer 2

只知道你的大概意思，可能跟我原来做的宏要求有点相似，不行你就改改吧

Sub zhidao()
' zhidao Macro
Dim Words, mystring0, mystring1, mystring2, rwindex, ats1, ats2
ats1 = 200 ' 暂时变量
ats2 = 622 ' 暂时变量
For Words = 1 To ats1 Step 1 ' 建立多次循环。
If Words < 10 Then ' 建立循环次数
mystring0 = "d:\apple\apple00" & Words & ".csv" ' 将数字添加到字符串中。
mystring1 = "apple00" & Words & ".csv" ' 不加绝对途径的文件名
mystring2 = "apple00" & Words ' 工作薄中表的名称
Else if
mystring0 = "d:\apple\apple0" & Words & ".csv" ' 将数字添加到字符串中。
mystring1 = "apple0" & Words & ".csv" ' 不加绝对途径的文件名
mystring2 = "apple0" & Words ' 工作薄中表的名称
If 99 < Words < 1000 Then ' 建立循环次数
mystring0 = "d:\apple\apple" & Words & ".csv" ' 将数字添加到字符串中。
mystring1 = "apple" & Words & ".csv" ' 不加绝对途径的文件名
mystring2 = "apple" & Words ' 工作薄中表的名称

End If
Workbooks.OpenText Filename:=mystring0, DataType:=xlDelimited, Tab:=True
For rwindex = 1 To ats2
If mystring1 = "apple001.csv" Then
Workbooks("apple00A.xls").Worksheets("Sheet1").Cells(rwindex, 1).Value = Workbooks(mystring1).Worksheets(mystring2).Cells(rwindex, 1)
End If
Workbooks("apple00A.xls").Worksheets("Sheet1").Cells(rwindex, Words + 1).Value = Workbooks(mystring1).Worksheets(mystring2).Cells(rwindex, 2)
Next rwindex
Workbooks(mystring1).Close
Next Words
End Sub

Answer 3

for i＝1 to 10

Answer 4

38967098我来抢生意了