2

我正在处理一系列大型工作簿，并使用一种工具从财务数据库 (SAP Financial Consolidation) 导入值。它的工作方式是使用 UDF，例如=GetCtData({parameters})or =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
4

4 回答 4

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
于 2015-10-28T21:50:05.720 回答
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 项目与本书一起保存不会给您带来太多麻烦。

于 2012-06-01T11:02:42.253 回答
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
于 2012-06-01T10:48:28.850 回答
0

这可能不是通用解决方案，但这是我要遵循的简单方法。1. 打开一个新文件 Book1，然后跳回到你的工作簿 2. Find/Replace-All in the workbook =GetCt to =[Book1]Sheet1!$A$1 3. BreakLinks to Book1 BreakLinks 的解释：它断开所有指向该文件并将引用它的单元格转换为值。我尽可能避免使用 UDF，因为与 MS Excel 开发人员编写的内置方法相比，它们容易效率低下。

于 2015-08-17T08:38:40.147 回答