SummerDawn

老婆晚上要加班做表格，重复度非常高，我见尤怜，特写了一段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

关于磨刀不误砍柴工一记

评论列表