EXCEL中 如何用宏实现 从每个其他的EXCEL提取特定一列放到一个新的EXCEL里？

Question

如题所述

Answer 1

详细Hi我

根据说明更改前面三行的参数：
--------------
Sub 合并选定工作簿的第1个工作表中的某几列()
Dim c0%: c0 = 1 '数据源表内，需要复制的列位置，1～256
Dim cNum%: cNum = 1 '单个数据源表内，需要复制的列数量，1～256
Dim c1%: c1 = 1 '结果表内，开始放置结果的列位置，1～256

Dim iBk0 As Workbook, iBk1 As Workbook, i%, iFiles
iFiles = Application.GetOpenFilename("Excel Files (*.xls), *.xls", , "请选择要合并的工作簿", , True)
If IsArray(iFiles) = 0 Then MsgBox "没有选择文件!": Exit Sub
Application.ScreenUpdating = False
Set iBk1 = ActiveWorkbook
For i = 1 To UBound(iFiles)
c1 = c1 + (i - 1) * cNum
If c1 + cNum - 1 > 256 Then MsgBox "列已放满256列！程序终止!": GoTo 100
Set iBk0 = GetObject(iFiles(i))
iBk0.Worksheets(1).Columns(c0).Resize(, cNum).Copy _
iBk1.Worksheets(1).Columns(c1).Resize(, cNum)
iBk0.Close False
Next i
100:
Set iBk0 = Nothing
Application.ScreenUpdating = True
MsgBox "完成！"
End Sub

Answer 2

详细Hi我

根据说明更改前面三行的参数:
--------------
Sub 合并选定工作簿的第1个工作表中的某几列()
Dim c0%: c0 = 1 '数据源表内，需要复制的列位置，1~256
Dim cNum%: cNum = 1 '单个数据源表内，需要复制的列数量，1~256
Dim c1%: c1 = 1 '结果表内，开始放置结果的列位置，1~256

Dim iBk0 As Workbook， iBk1 As Workbook， i%， iFiles
iFiles = Application.GetOpenFilename("Excel Files (*.xls)， *.xls"， ， "请选择要合并的工作簿"， ， True)
If IsArray(iFiles) = 0 Then MsgBox "没有选择文件，": Exit Sub
Application.ScreenUpdating = False
Set iBk1 = ActiveWorkbook
For i = 1 To UBound(iFiles)
c1 = c1 + (i - 1) * cNum
If c1 + cNum - 1 > 256 Then MsgBox "列已放满256列，程序终止，": GoTo 100
Set iBk0 = GetObject(iFiles(i))
iBk0.Worksheets(1).Columns(c0).Resize(， cNum).Copy _
iBk1.Worksheets(1).Columns(c1).Resize(， cNum)
iBk0.Close False
Next i
100:
Set iBk0 = Nothing
Application.ScreenUpdating = True。