EXCEL中 如何用宏实现 从每个其他的EXCEL提取特定一列放到一个新的EXCEL里? 30
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
MsgBox "完成!"
End Sub
根据说明更改前面三行的参数:
--------------
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
2015-06-26
展开全部
详细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。
根据说明更改前面三行的参数:
--------------
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。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |