关于磨刀不误砍柴工一记

linxiaoyun 2021.6.21 16:12 480 0
软件应用 Excel应用

老婆晚上要加班做表格,重复度非常高,我见尤怜,特写了一段vba程序(Excel二次开发),以期有所助益。

Sub SaveSeparately()
Application.ScreenUpdating = False

'硬编码文件名sheet1,应按实际调整
mydestsheetname="sheet1"

ipath = ActiveWorkbook.Path & "\"
'myoldname = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)

'硬编码位置C3,应按实际调整
mynewname = ActiveWorkbook.Sheets(mydestsheetname).[c3].Value

'保存多个sheet时,用下面循环语句
'For Each sht In Sheets
'Next


'有temp单元表时,删除
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("temp").Delete
Application.DisplayAlerts = True

'复制sheet1到temp
ActiveWorkbook.Sheets(mydestsheetname).Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).Name = "temp"
    
'修改单元表temp中公式为值
    With ActiveWorkbook.Sheets("temp").UsedRange
    c = .Column + .Columns.Count - 1
    r = .Row + .Rows.Count - 1
    End With
    
    ActiveWorkbook.Sheets("temp").[a1].Resize(r, c).Copy
    ActiveWorkbook.Sheets("temp").[a1].PasteSpecial xlPasteValues
    
'将单元表另存
ActiveWorkbook.Sheets("temp").Copy
'ActiveSheet.Name = mynewname
ActiveWorkbook.Sheets("temp").Name = mynewname
ActiveWorkbook.SaveAs ipath & mynewname & Format$(Now(), "yyyymmdd")
ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

主要用途是,当做成的模板文件(通常含有大量公式)后,使用命令,可以保存为仅有数值的独立表格,即其中格式仍同模板、而公式全替换为数值。

同时按文件名加日期命名。而文件名采用了特定位置的单元格值,应按实际调整。

该命令,硬编码了sheet1(模板文件的单元表名),应按实际调整。同时使用了temp的单元表名,也应注意是否冲突。

打开vba编辑器,贴入代码即可使用。

 

Last Modified·2021年6月23日 20:06

暂无评论

您尚未登录,请先才能评论。