excel vba值粘贴所有类型的公式" = X()"

时间:2015-07-08 19:02:28

标签: excel-vba array-formulas vba excel

我有一个数据库应用程序,它通过UDF将数据存储在数组公式中。

我希望有一个宏通过sheet / wbook,并通过将udf数组公式替换为给定单元格中的当前值来中断所有外部链接。

挑战在于给定数组公式中的单元格不能单独写入。例如,下面的宏将导致整个数组在第一次写入时被销毁。< / p>

Public Sub breaklink()
Dim c
For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
    Debug.Print c.FormulaArray
    If InStr(c.FormulaArray, "MYFORMULA(") Then
        Stop
        c.FormulaArray = c.Value
        'c.Value = c.Value     --THIS THROWS ERROR 1004 (Can't edit part of an array)
        Stop
    End If
Next
End Sub

如果有像c.getArrayFormulaRange这样的单元格方法,那么我可以用它来创建一个值数组,然后重写数组公式。

我可以想象在相邻的单元格中循环以尝试找到每个数组的边界,但这看起来非常麻烦(而且,我正在改变循环期间循环的范围,这可能会引发问题) 。是否有任何方法或对象属性可以帮助我识别给定数组公式占用的整个范围?

1 个答案:

答案 0 :(得分:0)

根据以上简单的MAn建议,这是我的解决方案:

Public Sub breakLinks(scope As String)
Dim formula_tokens()
Dim c As Range, fa_range As Range
Dim ws As Worksheet
Dim token
formula_tokens = Array("MYFORMULA1(", "MYFORMULA2(", "OTHERFORMULA(", "OTHERFORMULA2(")
If scope = "sheet" Then
    For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
        For Each token In formula_tokens
            If InStr(UCase(c.FormulaArray), token) Then
                If c.HasArray Then
                    Set fa_range = c.CurrentArray
                    fa_range.FormulaArray = fa_range.Value
                Else
                    c.Formula = c.Value
                End If
            End If
        Next
    Next

ElseIf scope = "wbook" Then
    For Each ws In Worksheets
        For Each c In ws.Cells.SpecialCells(xlCellTypeFormulas)
            For Each token In formula_tokens
                If InStr(UCase(c.FormulaArray), token) Then
                    If c.HasArray Then
                        Set fa_range = c.CurrentArray
                        fa_range.FormulaArray = fa_range.Value
                    Else
                        c.Formula = c.Value
                    End If
                End If
            Next
        Next
    Next

End If

End Sub