现在有100个工作簿,名字没有什么序号。每个工作簿里都有一张名字叫做B33的工作表,我想把每个工作簿里的B33工作表里的D22数据汇到一张公所表上,我该怎么办呢?总不至于每张工作簿都打开再引用吧?
我工作簿的名字放到了一张表里面,我在引用D22数据时,有没有什么办法将公式里的路径很快将工作簿的名字用表里的名字替换?
在公式引用中,如何快速引用其他工作表的数据
答案:1 悬赏:60
解决时间 2021-03-20 21:47
- 提问者网友:剪短发丝
- 2021-03-20 11:09
最佳答案
- 二级知识专家网友:不傲怎称霸
- 2021-03-20 11:57
汇总所有工作簿里的D33表不难
如果D33在所有工作簿里位置一样的话
我这里就有一个现成的宏程序
如果不一样修改下宏就OK了
Sub 合并当前根目录下所有工作簿的第N张工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long, J As Long
Dim Num As Long
Dim BOX As String
MyPath = activeworkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = activeworkbook.Name
Num = 0
BOX = InputBox("请输入您要合并的工作表号,以阿拉伯数值为准。" & Chr(13) & Chr(13) & _
"如要合并工作簿的第2张工作表,则输入“2”。" & Chr(13) & Chr(13) & _
"默认值为“1”。", "输入", 1)
If BOX = "" Then
Exit Sub
ElseIf IsNumeric(BOX) = False Then
MsgBox "请输入数值型数据。", vbCritical, "Error"
Exit Sub
ElseIf Val(BOX) <> Int(Val(BOX)) Then
MsgBox "请输入整数。", vbCritical, "Error"
Exit Sub
ElseIf Val(BOX) < 0 Then
MsgBox "请输入正整数。", vbCritical, "Error"
Exit Sub
ElseIf Val(BOX) > 255 Then
MsgBox "输入数据超过工作表的最大取值范围。", vbCritical, "Error"
Exit Sub
End If
Application.ScreenUpdating = False
J = BOX
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = WORKBOOKS.Open(MyPath & "\" & MyName)
Num = Num + 1
With WORKBOOKS(1).ActiveSheet
G = Sheets.Count
If J > G Then
Wb.Close False
Application.ScreenUpdating = True
MsgBox "您所输入的值超出工作簿" & Chr(13) & MyName & Chr(13) & _
"的工作表范围,因此强制推出。", vbCritical, "Error"
Exit Sub
End If
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
Wb.Sheets(J).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄的第" & J & "张工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
End Sub
如果D33在所有工作簿里位置一样的话
我这里就有一个现成的宏程序
如果不一样修改下宏就OK了
Sub 合并当前根目录下所有工作簿的第N张工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long, J As Long
Dim Num As Long
Dim BOX As String
MyPath = activeworkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = activeworkbook.Name
Num = 0
BOX = InputBox("请输入您要合并的工作表号,以阿拉伯数值为准。" & Chr(13) & Chr(13) & _
"如要合并工作簿的第2张工作表,则输入“2”。" & Chr(13) & Chr(13) & _
"默认值为“1”。", "输入", 1)
If BOX = "" Then
Exit Sub
ElseIf IsNumeric(BOX) = False Then
MsgBox "请输入数值型数据。", vbCritical, "Error"
Exit Sub
ElseIf Val(BOX) <> Int(Val(BOX)) Then
MsgBox "请输入整数。", vbCritical, "Error"
Exit Sub
ElseIf Val(BOX) < 0 Then
MsgBox "请输入正整数。", vbCritical, "Error"
Exit Sub
ElseIf Val(BOX) > 255 Then
MsgBox "输入数据超过工作表的最大取值范围。", vbCritical, "Error"
Exit Sub
End If
Application.ScreenUpdating = False
J = BOX
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = WORKBOOKS.Open(MyPath & "\" & MyName)
Num = Num + 1
With WORKBOOKS(1).ActiveSheet
G = Sheets.Count
If J > G Then
Wb.Close False
Application.ScreenUpdating = True
MsgBox "您所输入的值超出工作簿" & Chr(13) & MyName & Chr(13) & _
"的工作表范围,因此强制推出。", vbCritical, "Error"
Exit Sub
End If
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
Wb.Sheets(J).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄的第" & J & "张工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
End Sub
我要举报
如以上问答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
大家都在看
推荐资讯