Excel - 将某些公式转换为值 - 性能问题

Question

我正在处理一系列大型工作簿，并使用一种工具从财务数据库 (SAP Financial Consolidation) 导入值。它的工作方式是使用 UDF，例如 =GetCtData({parameters})或 =GetCtLabel({parameters}) .其中一个参数是单元格的输出值，因此在任何时候，单元格的值都是一个数字。

要与没有 Financial Consolidation 加载项的其他人共享这些工作簿，我需要将每个单元格转换为值。我不想将所有单元格转换为值，只有带有 =GetCt... 的单元格公式。下面是我到目前为止写的代码，它有三种(类似的)方法(两种被注释掉了)。它在小型工作簿上完美运行，但文件现在已经增长，可能总共有 250,000 多个单元格需要更新。 (大约 70 列 x 350 行 x 10+ 个工作表。)我试过运行它，但几个小时后它仍在运行。

任何人都可以提出更有效的方法吗？

Sub removeAllMagnitudeLinks()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    For Each sSheet In Worksheets
        If sSheet.Name <> "blankMagnitude" Then 'Don't remove links from the blankMagnitude sheet -- unnecessary
            If sSheet.FilterMode Then sSheet.ShowAllData

            Application.StatusBar = "Working on sheet #" & sSheet.Index & " of " & Worksheets.Count & ". Name: " & sSheet.Name

            On Error Resume Next
            While Err.Number = 0
                With sSheet.Cells.Find(What:="GetCt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'                    .Copy 'Copying and pasting is one approach, but may not be fastest
'                    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'                    .Formula = .Value 'This is another approach, which is certainly not very fast
                    .Value = .Value
                End With
            Wend
        End If
    Next sSheet
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Answer 1

这是一篇很老的帖子，所以我想你已经解决了这个问题，就像我必须做的一样。下面的代码实际上也适用于非常大的文件，而不是那么“好”，因为我不是程序员。

我拥有的另一个解决方案是在用户的 [非 SAP BFC] excel 中使用 UDF 的加载项，它允许无法访问 BFC/Magnitude 的用户使用 BFC 函数 [getctdata、getctlabel] 打开文件。如果您对这个帖子感兴趣，请回复帖子。

我希望有一天 SAP 醒来并将所有这些作为应用程序的一部分提供。

Sub killMagnitude()
Dim x As Double, y As Double, sorok As Double, Z As Double
Dim c, i As Long
Dim sor, oszlop As Long

'paste-special cells with links to magnitude data
Application.ScreenUpdating = False
Application.EnableEvents = False


c = Application.Worksheets.Count
Application.Calculation = xlCalculationManual

For i = 1 To c
Worksheets(i).Activate
Application.StatusBar = "removing magnitude links from sheet: " & Worksheets(i).Name
On Error Resume Next
Selection.SpecialCells(xlCellTypeLastCell).Select

x = ActiveCell.Row ' a tartomány -ig sora
y = ActiveCell.Column 'a tartomány -ig oszlopa

On Error GoTo 0


For sor = 1 To x
    For oszlop = 1 To y
    If Cells(sor, oszlop).HasFormula = True Then
    Z = InStr(1, Cells(sor, oszlop).Formula, "GetCtData", 0)

        If Z <> 0 Then
            Cells(sor, oszlop).Value = Cells(sor, oszlop).Value
        Else
        End If

    Z = InStr(1, Cells(sor, oszlop).Formula, "GetCtLabel", 0)

        If Z <> 0 Then
            Cells(sor, oszlop).Value = Cells(sor, oszlop).Value
        Else
        End If

    Else
    End If
    Next oszlop
Next sor

GoTo skip

skip:

Next i
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "magnitude calculations removed from workbook"

Application.EnableEvents = True

End Sub