创建新工作簿时减少文件大小

Question

我有一个包含 5 个工作表 + 1 个包含销售数据的报告，VBA 代码将报告从 5 个选项卡复制到一个新工作簿中并将其保存在本地。 一切正常，直到代码尝试保存它，大约需要 8-10 分钟，并且文件大小很大（XLSX 为 18 Mb，XLSB 为 8 Mb），而原始报告中过去的值则为 150 kB，然后保存手动作为 XLSX（在这种情况下我手动删除销售数据选项卡）

我需要做什么才能将文件大小减小到 150-200 kB 左右？

VBA：

Sub Export_Report()
        
    '** Source worksheet names
    Dim sWSnames() As Variant
    sWSnames = Array("Overview", "Product", "Sales", "E-com", "Inventory")
    
    '** Source Workbook (holds the code)
    Dim sWB As Workbook: Set sWB = ThisWorkbook

    '** Copy the worksheets to a new workbook
    sWB.Worksheets(sWSnames).Copy
    
    '** Destination Workbook
    Dim dWB As Workbook: Set dWB = Workbooks(Workbooks.Count)
    
    Dim dWS As Worksheet
    Dim dRNG As Range
    
    '** Convert formulas to values
    For Each dWS In dWB.Worksheets
        Set dRNG = dWS.UsedRange
        dRNG.Value = dRNG.Value
    Next dWS

    '** Save..
    Dim filePath As String
    Dim fileName As String

    filePath = sWB.Path
    fileName = "Report " & Format(Date, "YYYYMMDD")

    '** Save to same dir as sWB
    dWB.SaveAs fileName:=filePath & "\" & fileName & ".xlsb", _
    FileFormat:=xlExcel12, CreateBackup:=False

    '** Close dWB
    'dWB.Close SaveChanges:=False
    'Application.DisplayAlerts = False

End Sub

Answer 1

UsedRange

有时可能比您预期的大得多（因为它不仅仅考虑单元格内容）

代替：

For Each dWS In dWB.Worksheets
    Set dRNG = dWS.UsedRange
    dRNG.Value = dRNG.Value
Next dWS

尝试这样的事情：

'...
'...
For Each dWS In dWB.Worksheets
    ConvertFormulasToValues dWS
Next dWS
'...
'...

被叫子：

Sub ConvertFormulasToValues(ws As Worksheet)
    Dim drng As Range, a As Range
    On Error Resume Next 'ignore error if no formulas found
    Set drng = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0      'stop ignoring errors
    If Not drng Is Nothing Then
        For Each a In drng.Areas
            a.Value = a.Value
        Next a
    End If
End Sub