关于VBA中，activesheet用法的一些思考
前二天，给财务部做了个数据采集的工具，因为财务现在用的是excel2013 和2017的版本，所以我决定不用python，改用VBA来处理这个工具。
在 写过程的时候，我用了sheets(i)来定位表，写了好几个过程后，在最后整理过程的时候还好，如果写完再修改的话，会有一些麻烦。
因为sheets(i)已经限定了这个表，所以后期一旦修改的话，就会有很问题，因为要操作的表，并不一定是sheets(i).
后来实在没有办法了，我就用activesheets(i), 来替代这个sheets(i), 这样就会少去很多麻烦。
Sub 处理所有的预算文件夹下的数据为一维表() '处理所有的预算文件夹下的数据为一维表 Application.ScreenUpdating = False
Application.DisplayAlerts = False
'获取当前文件夹所有文件
Folder = ActiveWorkbook.Path & "\"
AWbName = ActiveWorkbook.Name '当前工作表的名字
Filename = Dir(Folder)
MyPath = Folder & AWbName
While Filename <> AWbName And Filename <> "合并后的预算二维表总表.xlsm"
Set Wb = Workbooks.Open(Folder & Filename) '此处写要处理文件的逻辑代码 '以下是处理预算的逻辑
Call 处理预算数据 '下面是处理业绩的逻辑
'Call 处理业绩数据 ' Debug.Print Filename
Wb.Save
Wb.Close False
Filename = Dir
Wend Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "处理完毕！"
End Sub Sub 处理所有的业绩文件夹下的数据为一维表() '处理所有的预算文件夹下的数据为一维表 Application.ScreenUpdating = False
Application.DisplayAlerts = False '获取当前文件夹所有文件
Folder = ActiveWorkbook.Path & "\"
AWbName = ActiveWorkbook.Name '当前工作表的名字
Filename = Dir(Folder)
MyPath = Folder & AWbName
While Filename <> AWbName And Filename <> "合并后的业绩二维表总表.xlsm"
Set Wb = Workbooks.Open(Folder & Filename) '此处写要处理文件的逻辑代码 '以下是处理预算的逻辑
'Call 处理预算数据 '下面是处理业绩的逻辑
Call 处理业绩数据 ' Debug.Print Filename
Wb.Save
Wb.Close False
Filename = Dir
Wend Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "处理完毕！"
End Sub '======================================
Sub 处理预算数据()
'====================================== Application.ScreenUpdating = False
Application.DisplayAlerts = False '获取有数据的最大行数 max_row_A = Sheets(1).Range("a65536").End(xlUp).Row '复制第一张工作做为副本放到最后
Sheets(1).Select
Sheets(1).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select '先删除汇总和人员配备所在的行 因为一维表用不到这两行数据
ActiveSheet.Range("A" & max_row_A).EntireRow.Delete
'ActiveSheet.Range("A" & max_row_A - 1).EntireRow.Delete 'Debug.Print max_row 'Range("a" & 11).Select 'Range("G4:AQ1").Select
'Selection.Delete '===========================处理每月数据START================================================= For i = 7 To 39 Step 3 '复制每月的数据
Range(Cells(7, i), Cells(max_row_A, i + 2)).Cut '判断d列有数据的行数,以便粘贴月份的数据
max_row_D = Sheets(Sheets.Count).Range("d65536").End(xlUp).Row '选择要粘贴的月份的单元格，开始粘贴,这里max_row+2是因为最后一行数据是空，所以要再加1
'此处要判断一下单元A列与D列的有数据的行，因为D列的最后一行数据有空行的出现
If max_row_A = max_row_D Then
Range("D" & max_row_D + 1).Select
ActiveSheet.Paste
Else
Range("D" & max_row_D + 1).Select
ActiveSheet.Paste End If Next
'===========================处理每月数据END================================================= '判断a列有数据的行数(主要是取表头的数据)不能放在
Application.CutCopyMode = False
max_row_b = Sheets(Sheets.Count).Range("a65536").End(xlUp).Row
Set data_hear = Range(Cells(7, 1), Cells(max_row_b, 3))
'Set data_tail = Range(Cells(7, 43), Cells(max_row_b, 43)) For k = 1 To 11
' Debug.Print Sheets(1).Range("d65536").End(xlUp).Row
If Sheets(Sheets.Count).Range("d65536").End(xlUp).Row <> 0 Then '判断a列有数据的行数
'max_row_b = Sheets(1).Range("a65536").End(xlUp).Row
'处理表头的数据
data_hear.Copy
'data_tail.Copy max_row_A = Sheets(Sheets.Count).Range("a65536").End(xlUp).Row
'选择要粘贴的单元格
Range("a" & max_row_A + 1).Select '开始粘贴
ActiveSheet.Paste End If
Next
'删除表头的内容，让右则的单元格来补充
Range("G6:BO6").Select
Selection.Delete Shift:=xlToLeft
Range("A7").Select '增加预算年、预算月、数据来源
'===================处理年份start================================================ '写入汇率数据和月份
Range("J6") = "数据来源"
Range("I6") = "预算月"
Range("H6") = "预算年" '************************ '设置Q列的数据格式为数值类型 Columns("Q:Q").Select Selection.NumberFormatLocal = "0_);[红色](0)" '设置G列的格式为文本类型---预算年
Columns("G:G").Select
Selection.NumberFormatLocal = "@" r = Range("b65536").End(xlUp).Row
For P = 7 To r
Range("H" & P) = Year(Date) '处理预算年的值
Range("J" & P) = Application.ActiveWorkbook.Name '处理数据来源的值 Next
'===================处理年份end================================================ '===================处理月份start================================================ '处理月份 '插入月份，共有十二个月份，所以要循环12次，每个月份共有几行，要获取开始A列是最大有数据的行数 '先插入一列做为表头 interval = (r - 6) / 12
end_index = 12 * interval + 1
start_index = 1
For t = 1 To end_index - 1 Range("I" & t + 6) = start_index & "月" If t Mod interval = 0 Then start_index = start_index + 1
End If
Next '===================处理月份end================================================ '处理删除汇总列 Columns("AN:AP").Select
'Selection.Delete Shift:=xlToLeft '删除表头不用的数据 'Range("E3:I4").Select
'Selection.ClearContents '删除多余的行
Rows("2:3").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp '===================删除汇总start================================================ '删除表中带有“汇总”字样的单元格所在的行 '获取C列有数据的最大行
max_row_c = Sheets(Sheets.Count).Range("A65536").End(xlUp).Row '循环判断单元格的值是否含有"汇总"字样，如果有，则删除当前行 "部门人员配备*" For x = max_row_c To 7 Step -1 If Range("A" & x).Value Like "*汇总" Then Range("A" & x).EntireRow.Delete End If Next '===================删除汇总end=================================================== '===================处理明年费用（支出）特别说明start========================== ' '
Application.CutCopyMode = False
max_row_b = Sheets(Sheets.Count).Range("AP65536").End(xlUp).Row Set data_tail = Range(Cells(5, 43), Cells(max_row_b, 43)) For G = 0 To 11
' Debug.Print Sheets(1).Range("b65536").End(xlUp).Row
If Sheets(Sheets.Count).Range("H65536").End(xlUp).Row <> Sheets(Sheets.Count).Range("G65536").End(xlUp).Row Then '判断a列有数据的行数
'max_row_b = Sheets(1).Range("a65536").End(xlUp).Row
'处理表头的数据 data_tail.Copy max_row_i = Sheets(Sheets.Count).Range("AQ65536").End(xlUp).Row '选择要粘贴的单元格
Range("G" & 5 + (max_row_b - 4) * G).Select '开始粘贴
ActiveSheet.Paste End If
Next
'===================处理明年费用（支出）特别说明end================================ '************************
'更改表头字段 Range("D4").Value = "当年预算数据"
Range("E4").Value = "当年实际数据"
Range("F4").Value = "明年预算数据"
Range("G4").Value = "明年费用（支出）预算特别说明" Sheets(1).Select '处理上面的格式 Application.ScreenUpdating = True
Application.DisplayAlerts = True 'Application.DisplayAlerts = False
'ActiveWorkbook.Save
'ActiveWorkbook.Close
'Application.DisplayAlerts = True End Sub Sub 处理业绩数据() Application.ScreenUpdating = False
Application.DisplayAlerts = False '获取有数据的最大行数,这里为什么用B65536呢，是因为A列的部门的值有很多是空值 ，所以统计不出来真实数值 max_row_A = Sheets(1).Range("b65536").End(xlUp).Row '复制第一张工作做为副本放到最后
Sheets(1).Select
Sheets(1).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select 'Debug.Print max_row 'Range("a" & 11).Select 'Range("G4:AQ1").Select
'Selection.Delete For i = 15 To 70 Step 5 '复制每月的数据
Range(Cells(6, i), Cells(max_row_A, i + 4)).Select
Range(Cells(6, i), Cells(max_row_A, i + 4)).Cut '判断j列有数据的行数,以便粘贴月份的数据
max_row_D = Sheets(Sheets.Count).Range("j65536").End(xlUp).Row '选择要粘贴的月份的单元格，开始粘贴,这里max_row+2是因为最后一行数据是空，所以要再加1
'此处要判断一下单元A列与D列的有数据的行，因为D列的最后一行数据有空行的出现
If max_row_A = max_row_D Then
Sheets(Sheets.Count).Range("j" & max_row_D + 1).Select
ActiveSheet.Paste
Else
Sheets(Sheets.Count).Range("j" & max_row_D + 1).Select
ActiveSheet.Paste End If Next '判断a列有数据的行数(主要是取表头的数据)不能放在
Application.CutCopyMode = False
max_row_b = Sheets(Sheets.Count).Range("b65536").End(xlUp).Row
Set data_hear = Range(Cells(6, 1), Cells(max_row_b, 4)) For k = 1 To 11
' Debug.Print Sheets(1).Range("j65536").End(xlUp).Row
'If Sheets(1).Range("j65536").End(xlUp).Row <> 0 Then '判断a列有数据的行数
'max_row_b = Sheets(1).Range("a65536").End(xlUp).Row
'处理表头的数据
data_hear.Copy max_row_A = Range("b65536").End(xlUp).Row '选择要粘贴的单元格
Range("a" & max_row_A + 1).Select '开始粘贴
ActiveSheet.Paste 'End If
Next '删除表头的内容，让右则的单元格来补充
Range("O3:BZ5").Select
Selection.Delete Shift:=xlToLeft
Range("A7").Select '写入汇率数据和月份
Range("Q5") = "明年平均汇率"
Range("P5") = "预算月"
Range("O5") = "预算年"
Range("R5") = "数据来源" '处理数据来源的值 '设置Q列的数据格式为数值类型 Columns("O:O").Select Selection.NumberFormatLocal = "0_);[红色](0)" '设置O列的格式为文本类型
Columns("Q:Q").Select
Selection.NumberFormatLocal = "@" r = Range("b65536").End(xlUp).Row
For P = 6 To r
Range("O" & P) = Year(Date)
Range("Q" & P) = Range("G3").Value
Range("R" & P) = Application.ActiveWorkbook.Name '处理数据来源的值 Next '处理月份 '插入月份，共有十二个月份，所以要循环12次，每个月份共有几行，要获取开始A列是最大有数据的行数 '先插入一列做为表头 interval = (r - 5) / 12
end_index = 12 * interval + 1
start_index = 1
For t = 1 To end_index - 1 Range("P" & t + 5) = start_index & "月" If t Mod interval = 0 Then start_index = start_index + 1
End If
Next '处理删除汇总列 Columns("E:I").Select
Selection.Delete Shift:=xlToLeft '删除表头不用的数据 Range("E3:I4").Select
Selection.ClearContents '删除多余的行
Rows("2:3").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp '删除表中带有“小计”字样的单元格所在的行 '获取C列有数据的最大行
max_row_c = Sheets(Sheets.Count).Range("C65536").End(xlUp).Row '循环判断单元格的值是否含有"小计"字样，如果有，则删除当前行 For x = max_row_c To 4 Step -1 If Range("C" & x).Value Like "*小计" Then Range("C" & x).EntireRow.Delete End If If Range("B" & x).Value Like "*合计" Then Range("B" & x).EntireRow.Delete End If Next Sheets(1).Select Application.ScreenUpdating = True
Application.DisplayAlerts = True 'Application.DisplayAlerts = False
''file = ThisWorkbook.Path & "处理后的业绩一维表.xlsx"
''ActiveWorkbook.SaveAs Filename:=file
'
'Sheets(Sheets.Count).Save
'ActiveWorkbook.Close
'
'Application.DisplayAlerts = True End Sub Sub 生成全部_业绩_二维表() ' 业绩二维表的表头是五行，数据从第六行开始。
'而 预算二维表的表头是六行，数据是从第七行开始的 Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False
Application.DisplayAlerts = False MyPath = ActiveWorkbook.Path '获取当前文件所在的目录 MyName = Dir(MyPath & "\" & "*.xls*") '获取当前目录下的所有包含xls扩展名的文件 AWbName = ActiveWorkbook.Name '当前工作表的名字 Num = 0
'Cells.Delete Do While MyName <> "" If MyName <> AWbName Then If MyName <> "合并后的业绩一维表总表.xlsm" Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) '**********************************************
'* *
'* 处理删除二维表中的所有汇总字段 *
'* ' *
'********************************************** '===================删除汇总start================================================ '删除表中带有“汇总”字样的单元格所在的行 '获取C列有数据的最大行
max_row_c = Sheets(1).Range("B65536").End(xlUp).Row
'Cells.Delete '循环判断单元格的值是否含有"汇总"字样，如果有，则删除当前行 "部门人员配备*" For x = max_row_c To 7 Step -1 If Range("C" & x).Value Like "*小计" Then Range("C" & x).EntireRow.Delete End If If Range("B" & x).Value Like "*合计" Then Range("B" & x).EntireRow.Delete End If Next '===================删除汇总end=================================================== '在没有复制之前，先把表头写上
Rows("1:5").Select
Rows("1:5").Copy Workbooks(1).ActiveSheet.Cells(1, 1) '写入表头 'Wb.Sheets(1).Range("A1:BQ5").Copy Workbooks(1).ActiveSheet.Cells(1, 1) '写入表头 Num = Num + 1 'Name是为了最后消息提示用的。
max_row = Wb.Sheets(1).Range("b65536").End(xlUp).Row
With Workbooks(1).ActiveSheet .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To 1 'Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '带表头
Wb.Sheets(G).Rows("6:5000").Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '不带表头
'Wb.Sheets(G).Rows("6:" & .Range("B65536").End(xlUp).Row).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '不带表头 'Wb.Sheets(G).Range("A6:BQ" & max_row).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '不带表头 Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If
End If MyName = Dir '获取下个文件名 Loop Range("B1").Select file = MyPath & "\合并后的业绩二维表总表.xlsm"
Workbooks(1).SaveAs Filename:=file 'Workbooks(1).SaveAs "2022年费用支出预算表.xlsx"
Application.ScreenUpdating = True
Application.DisplayAlerts = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
Application.Quit End Sub Sub 生成全部_预算_二维表() ' 业绩二维表的表头是五行，数据从第六行开始。
'而 预算二维表的表头是六行，数据是从第七行开始的 Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False
Application.DisplayAlerts = False MyPath = ActiveWorkbook.Path '获取当前文件所在的目录 MyName = Dir(MyPath & "\" & "*.xls*") '获取当前目录下的所有包含xls扩展名的文件 AWbName = ActiveWorkbook.Name '当前工作表的名字 Num = 0
'Cells.Delete Do While MyName <> "" If MyName <> AWbName Then If MyName <> "合并后的预算一维表总表.xlsm" Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) '**********************************************
'* *
'* 处理删除二维表中的所有汇总字段 *
'* ' *
'********************************************** '===================删除汇总start================================================ '删除表中带有“汇总”字样的单元格所在的行 '获取C列有数据的最大行
max_row_c = Sheets(1).Range("B65536").End(xlUp).Row '循环判断单元格的值是否含有"汇总"字样，如果有，则删除当前行 "部门人员配备*" For x = max_row_c To 7 Step -1 ' If Range("C" & x).Value Like "*小计" Then
'
' Range("C" & x).EntireRow.Delete
If Range("A" & x).Value Like "*汇总" Then Range("A" & x).EntireRow.Delete End If If Range("C" & x).Value Like "部门人员配备*" Then Range("C" & x).EntireRow.Delete End If Next '===================删除汇总end=================================================== '==================================================== '在没有复制之前，先把表头写上
'Wb.Sheets(1).Rows("1:6").Select
Wb.Sheets(1).Rows("1:6").Copy Workbooks(1).ActiveSheet.Cells(1, 1) '写入表头 'Wb.Sheets(1).Range("A1:BQ5").Copy Workbooks(1).ActiveSheet.Cells(1, 1) '写入表头 Num = Num + 1 'Name是为了最后消息提示用的。
max_row = Wb.Sheets(1).Range("b65536").End(xlUp).Row
With Workbooks(1).ActiveSheet .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To 1 '如果需要把隐藏的表也复制，就用sheets.count 'Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '带表头
Wb.Sheets(G).Rows("7:5000").Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '不带表头
'Wb.Sheets(G).Rows("6:" & .Range("B65536").End(xlUp).Row).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '不带表头 'Wb.Sheets(G).Range("A6:BQ" & max_row).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '不带表头 Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If
End If MyName = Dir '获取下个文件名 Loop Range("B1").Select
file = MyPath & "\" & "合并后的预算二维表总表" & ".xlsm"
ActiveWorkbook.SaveAs Filename:=file Application.DisplayAlerts = True
Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
Application.Quit End Sub Sub 生成全部_业绩_一维表() '业绩一维表的表头是三行，数据从第四行开始。
'而预算一维表的表头是四行，数据是从第五行开始的 Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False
Application.DisplayAlerts = False MyPath = ActiveWorkbook.Path '获取当前文件所在的目录 MyName = Dir(MyPath & "\" & "*.xls*") '获取当前目录下的所有包含xls扩展名的文件 AWbName = ActiveWorkbook.Name '当前工作表的名字 Num = 0
'必须要加上这句代码，作用：删除当前表的所有数据，初始化，如果不加，生成的一维总表会带有二维的数据
Cells.Delete Do While MyName <> "" If MyName <> AWbName Then If MyName <> "合并后的业绩二维表总表.xlsm" Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) '========================================================================================
'在没有复制之前，先把表头写上
'Wb.Sheets(1).Rows("1:4").Select
Wb.Sheets(Sheets.Count).Rows("1:3").Copy Workbooks(1).ActiveSheet.Cells(1, 1) '写入表头 Num = Num + 1 'Name是为了最后消息提示用的。
max_row = Wb.Sheets(Sheets.Count).Range("b65536").End(xlUp).Row
With Workbooks(1).ActiveSheet .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = Sheets.Count To Sheets.Count '如果需要把隐藏的表也复制，就用sheets.count Wb.Sheets(G).Rows("4:10000").Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '不带表头 Next WbN = WbN & Chr(13) & Wb.Name
Wb.Sheets(Sheets.Count).Delete
Wb.Close False End With End If End If MyName = Dir '获取下个文件名
'把用完的最后一张表删除
'Debug.Print Wb.Sheets(Sheets.Count).Name Loop Range("B1").Select
'file = MyPath & "\合并后的业绩一维表总表.xlsm"
'ActiveWorkbook.Save '动态计算毛利率的值
'获取整个表的总行数 count_rows = ActiveSheet.Range("L65536").End(xlUp).Row Debug.Print count_rows
For h = 4 To count_rows '如果H列单元格的值为0 ，则清空此单元格 If Range("H" & h).Value = 0 Then
Range("H" & h).Value = "" End If If Range("E" & h) <> 0 Then
If Range("C" & h) = "$" Then
On Error Resume Next Debug.Print Round((Range("E" & h) - Range("F" & h)) / Range("E" & h), 3)
Range("I" & h) = Round((Range("E" & h) - Range("F" & h)) / Range("E" & h), 3)
Else On Error Resume Next
Debug.Print Round(((Range("E" & h) * Range("L" & h) - Range("F" & h)) / Range("E" & h) * Range("L" & h)), 3)
Range("I" & h) = Round(((Range("E" & h) * Range("L" & h) - Range("F" & h)) / (Range("E" & h) * Range("L" & h))), 3) End If
Else
Range("I" & h) = 0 End If Next file = MyPath & "\合并后的业绩一维表总表.xlsm"
ActiveWorkbook.SaveAs Filename:=file Application.ScreenUpdating = True
Application.DisplayAlerts = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
Application.Quit End Sub Sub 生成全部_预算_一维表() '业绩一维表的表头是三行，数据从第四行开始。
'而预算一维表的表头是四行，数据是从第五行开始的 Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False
Application.DisplayAlerts = False MyPath = ActiveWorkbook.Path '获取当前文件所在的目录 MyName = Dir(MyPath & "\" & "*.xls*") '获取当前目录下的所有包含xls扩展名的文件 AWbName = ActiveWorkbook.Name '当前工作表的名字 Num = 0
'必须要加上这句代码，作用：删除当前表的所有数据，初始化，如果不加，生成的一维总表会带有二维的数据
Cells.Delete Do While MyName <> "" If MyName <> AWbName Then
If MyName <> "合并后的预算二维表总表.xlsm" Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) '========================================================================================
'在没有复制之前，先把表头写上
'Wb.Sheets(1).Rows("1:4").Select
Wb.Sheets(Sheets.Count).Rows("1:4").Copy Workbooks(1).ActiveSheet.Cells(1, 1) '写入表头 Num = Num + 1 'Name是为了最后消息提示用的。
max_row = Wb.Sheets(Sheets.Count).Range("b65536").End(xlUp).Row
With Workbooks(1).ActiveSheet .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = Sheets.Count To Sheets.Count '如果需要把隐藏的表也复制，就用sheets.count Wb.Sheets(G).Rows("5:10000").Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '不带表头 Next '删除用过的中间表。
'Debug.Print Wb.Sheets(Sheets.Count).Name WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If
End If MyName = Dir '获取下个文件名 Loop Range("B1").Select
file = MyPath & "\合并后的预算一维表总表.xlsm"
ActiveWorkbook.SaveAs Filename:=file Application.ScreenUpdating = True
Application.DisplayAlerts = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
Application.Quit End Sub
关于VBA中，activesheet用法的一些思考的更多相关文章
- 在VBA中使用Windows API
VBA是一种强大的编程语言,可用于自定义Microsoft Office解决方案.通过使用VBA处理一个或多个Office应用程序对象模型,可以容易地修改Office应用程序的功能或者能够使两个或多个 ...
- VBA中四种自动运行的宏以及模块的含义
在Excel的“标准模块”中可以创建4种自动运行的宏,它们分别是Auto_Open(打开工作 簿时自动运行), Auto_Close, Auto_Activate, Auto_Deactivate. ...
- VBA中find的一些使用方法
用excel处理数据的时候,无论是使用VBA还是函数,查找和引用都是两大主要的工作,VBA中的find系列的方法(find.findnext.Range.FindPrevious)返回range对象, ...
- 【LeetCode刷题】SQL-Second Highest Salary 及扩展以及Oracle中的用法
转载于:https://www.cnblogs.com/contixue/p/7057025.html Write a SQL query to get the second highest sala ...
- [转载]C#中MessageBox.Show用法以及VB.NET中MsgBox用法
一.C#中MessageBox.Show用法 MessageBox.Show (String) 显示具有指定文本的消息框. 由 .NET Compact Framework 支持. MessageBo ...
- ORACLE 中ROWNUM用法总结(转)
ORACLE 中ROWNUM用法总结! 对于 Oracle 的 rownum 问题,很多资料都说不支持>,>=,=,between...and,只能用以上符号(<.<=.!=) ...
- VB类模块中属性的参数——VBA中Range对象的Value属性和Value2属性的一点区别
在VB中,属性是可以有参数的,而VBA中属性使用参数非常常见.比如最常用的:Worksheet.Range("A1:A10") VB的语法,使用参数的不一定是方法,也有可能是属性 ...
- AngularJS select中ngOptions用法详解
AngularJS select中ngOptions用法详解 一.用法 ngOption针对不同类型的数据源有不同的用法,主要体现在数组和对象上. 数组: label for value in a ...
- 在VBA中新建工作簿
用程序计算数据,得到不同公司.不同项目的数据结果,最终还要将每个公司的数据结果放在各自的单独文件中.这就需要在vba中新建.保存excel文件.掌握几个东西就能很熟练了:1.要想保存在当前目录下,需要 ...
- 在VBA中调用excel函数
以前不太会用VBA时,都是在excel中使用函数来计算一些数据.毕竟函数不如代码,效率比较低.所以,就学着怎么在VBA中引用Excel函数.平时我用得比较多的函数就是countif和sumif函数.1 ...
随机推荐
- 【题解】CF1722F L-shapes
题面传送门 其实这题根本不用搜索,有耐心即可. 可以发现,在 \(n\times m\) 范围内扫,可能合法的只有以下四种情况,其中蓝色代表示是 *,红色表示不能是 *,其中黄色五角星表示当前 \(i ...
- 自学 TypeScript 第一天 环境开发配置 及 TS 基本类型声明
前言: 自学第一天,什么是TS ,为什么要用 TS TS 全程 Typed JavaScript at Any Scale 解释起来就是 添加了类型系统的 JavaScript, 是 JavaScr ...
- lvm+xfs的扩缩容
ext4文件系统可以经行扩缩容操作,但xfs的文件系统只能扩容,无法缩容 所以如果需要进行xfs的缩容,可以先使用xfsdump备份文件系统,然后对逻辑卷(/分区)进行缩容操作(此时原xfs文件系统会 ...
- 关于linux mint更改资源管理器的快捷键
前言 首先要知道 linux mint 的默认资源管理器是 nemo 我很不习惯 ctrl+d 在nemo里面是 收藏到侧边栏 我习惯 ctrl+d 在windows上是删除文件 所以下面我就修改这个 ...
- 【Java SE】Day02 数据类型转换、运算符、方法入门
一.数据类型转换 1.自动转换 取值范围小在运算时会提升为取值范围大的类型 byte+int=int int+double=double 转换规则:byte.short.char-->int-- ...
- L1-064 估值一亿的AI核心代码 (20分)
L1-064 估值一亿的AI核心代码 (20分) 以上图片来自新浪微博. 本题要求你实现一个稍微更值钱一点的 AI 英文问答程序,规则是: 无论用户说什么,首先把对方说的话在一行中原样打印出来: 消除 ...
- 一文带你搞懂 Google 发布的新开源项目 GUAC
随着软件供应链攻击的显著增加,以及 Log4j 漏洞带来的灾难性后果和影响,软件供应链面临的风险已经成为网络安全生态系统共同关注的最重要话题之一.根据业内权威机构 Sonatype 发布的2022软件 ...
- WPF中的“资源”
WPF中的"资源" 资源概述 WPF中的资源的概念有点类似 web 技术中的静态资源的概念.可以是一个样式,也可以是一个button的边框设置集合. 可以简单的将资源分为如下几个类 ...
- 通过 CancellationToken 提高 Web 性能
在 Web 开发中,经常会遇到这样的场景:用户发起一个请求,Web 服务器执行一些计算密集型的操作,等待结果返回给用户.这种情况下,如果用户在等待结果的过程中取消了请求,那么服务器端依然会继续执行计算 ...
- python基础re模块与正则
正则表达式前戏 正则表达式是用来匹配与查找字符串的,从网上爬取数据自然或多或少会用到正则表达式,python的正则表达式要先引入re模块,正则表达式以r引导 案例:手机号校验 基本要求:手机号必须是1 ...