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

时间:2012-06-01 10:00:35

标签: excel excel-vba vba

我正在使用一系列大型工作簿并使用工具从财务数据库导入值(SAP Financial Consolidation)。它的工作方式是使用=GetCtData({parameters})=GetCtLabel({parameters})等UDF。其中一个参数是单元的输出值,这样在任何时候单元的值都是数字。

要与没有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

4 个答案:

答案 0 :(得分:1)

这是一篇相当古老的帖子,所以我猜你已经解决了这个问题,就像我必须这样做一样。下面的代码实际上也适用于非常大的文件而不是那么好的&#39;因为我不是程序员。

我拥有的另一个解决方案是在[非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

答案 1 :(得分:0)

我会尝试像这样的变种数组方法

Sub removeAllMagnitudeLinks()
    Dim sSheet As Worksheet
    Dim vFormulas As Variant
    Dim vValues As Variant
    Dim j As Long
    Dim k As Long
    Dim strFormula As String
    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

            vFormulas = sSheet.UsedRange.Formula
            vValues = sSheet.UsedRange.Value2
            For j = LBound(vFormulas) To UBound(vFormulas)
                For k = LBound(vFormulas, 2) To UBound(vFormulas, 2)
                    strFormula = CStr(vFormulas(j, k))
                    If Len(strFormula) > 0 Then
                        If Left$(strFormula, 1) = "=" Then
                            If InStr(1, strFormula, "GetCt", vbTextCompare) Then
                                vFormulas(j, k) = vValues(j, k)
                            End If
                        End If
                    End If
                Next k
            Next j
            sSheet.UsedRange.Formula = vFormulas

        End If
    Next sSheet
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

答案 2 :(得分:0)

保存为XML格式的Excel书籍类似于

...
<Row>
 <Cell ss:Index="2" ss:Formula="=4+2"><Data ss:Type="Number">6</Data><NamedCell
   ss:Name="MyRange"/></Cell>
</Row>
<Row>
 <Cell ss:Index="2" ss:Formula="=5+2"><Data ss:Type="Number">7</Data><NamedCell
   ss:Name="MyRange"/></Cell>
</Row>
...

这应该很容易用正则表达式等解析和批量替换(如果需要,我可以提供代码)如果没有保存VB项目,那本书不会给你带来太多麻烦。

答案 3 :(得分:0)

这可能不是一般解决方案,但这是我要遵循的一种简单方法。 1.打开一个新文件Book1,然后跳回到您的工作簿 2.在工作簿中查找/替换全部= GetCt to = [Book1] Sheet1!$ A $ 1 3. BreakLinks到Book1 BreakLinks的说明:它断开与该文件的所有链接,并将引用它的单元格转换为值。 我尽可能地避免使用UDF,因为与MS Excel开发人员编写的内置方法相比,它们容易出现低效率。