如果公式包含#REF,则为VBA粘贴单元格值!错误

时间:2016-10-17 20:37:33

标签: excel vba excel-vba

在发送预算文件excel文件时,我需要先将它们复制到新书中,然后删除文档中用于获取其值的公式部分。我这样做没有计算,所以#REF错误出现在公式中,但值直到我计算时才会#REF。

然后我想使用这些#REF错误作为标识符来搜索,复制单元格值(预计算)并粘贴为值,这样我就可以保留该值。

我有一个解决方案可以在下面工作,但这需要十分钟。

Sub Value_REF2()

'Definitions
Dim lCount As Long
Dim rFoundCell As Range
Dim rng As Range
Dim cell As Range


'If Error go to Process Error function
On Error GoTo ProcError

    'Remove any #REF in text first to prevent infinite loop in find below
    Set rng = Range("A1:BB999") 'Range may need adjusting based on Grid

    'For Loop
    For Each cell In rng

    If cell.Text = "#REF!" Then
        cell.ClearContents
    End If

    Next cell


    ' Search for #REFs in forumlas
    Set rFoundCell = Range("A1")

            Do
            Set rFoundCell = Cells.Find(What:="#REF", After:=rFoundCell, _
                LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False)
             'Take found cell and copy paste values
             With rFoundCell
                 .Copy
                 .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             End With

            Loop 'Error will occur, this will trigger ProcError function

'Process Error Function - Exit Sub
ProcError:
    Exit Sub

End Sub

我的下一个解决方案应该快得多,但我不知道如何在实际公式中使IsError看起来而不仅仅是单元格。

IsError(cell.Formula)似乎不起作用?

Sub Value()


    Dim rng As Range

    Application.ScreenUpdating = False
    Application.Interactive = False


    Set rng = Range("A1:BB999")

    With ActiveSheet
        For Each cell In rng
            If IsError(cell.Formula) Then
                cell.Copy
                cell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If
        Next cell

    End With

    Application.ScreenUpdating = True
    Application.Interactive = True

End Sub

这样做的主要目的是保留所有不在预算表之外引用的公式(如FTE计算或小计和总计),而只保留那些看起来在外面的值。

任何想法?

0 个答案:

没有答案