如果单元格值 =“N/A”，则复制并粘贴值

Question

我想将值复制并粘贴到一系列单元格，但前提是它们的值 =“N/A”。我想保留公式，因为它们在所有不 =“N/A”的单元格中。

在上下文中，我有数百个 VLOOKUP。示例：

=IFERROR(VLOOKUP("L0"&MID(G$4,1,1)&"A0"&MID(G$4,1,1)&MID(G$4,3,2)&"-0"&$B6,Sheet1!$C:$D,2,FALSE),"N/A")

VBA 可以做到这一点吗？

Answer 1

首先，您应该使用真实的错误值，而不是只看起来像错误的字符串。其次，VLOOKUP如果没有找到查找值直接返回N/A错误，所以IFERROR包装可以省略。所以公式

=VLOOKUP("L0"&MID(G$4,1,1)&"A0"&MID(G$4,1,1)&MID(G$4,3,2)&"-0"&$B6,Sheet1!$C:$D,2,FALSE)

就足够了。

要将N/A结果替换为错误值，可以使用这个

Sub Demo()
    Dim ws As Worksheet
    Dim rngSrc As Range
    Dim datV As Variant, datF As Variant
    Dim i As Long

    ' Get range to process by any means you choose
    '  For example
    Set ws = ActiveSheet
    With ws
        Set rngSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With

    ' Copy data to variant arrays for efficiency
    datV = rngSrc.Value
    datF = rngSrc.Formula

    ' replace erroring formulas
    For i = 1 To UBound(datV, 1)
        If IsError(datV(i, 1)) Then
            If datV(i, 1) = CVErr(xlErrNA) Then
                datF(i, 1) = CVErr(xlErrNA)
            End If
        End If
    Next

    ' return data from variant arrays to sheet
    rngSrc.Formula = datF



End Sub

如果您真的想使用字符串而不是真正的错误值，请调整 If 行以适应

Answer 2

您可以使用SpecialCells 来缩短使用=NA()cells 的时间，而不是遍历范围内的所有单元格

这也开辟了一个非VBA方法（如果唯一的错误单元格是NA，即没有Div#/0）

1. 下面的前两种方法（手动和代码）处理您只提供NA 单元格的情况
2. 第三个使用SpecialCells 仅关注需要测试的单元格，然后在进行更新之前对NA 进行检查

选项1

手动选择评估为错误的公式单元格

• 选择感兴趣的范围
• 按 [F5]。
• 点击特殊
• 选择公式
• 只检查错误

选项2

VBA 更新评估为错误的公式单元格

代码

Sub Shorter()
Dim rng1 As Range
On Error Resume Next
' All error formulas in column A
Set rng1 = Columns("A").SpecialCells(xlCellTypeFormulas, 16)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
'update with new value (could be value or formulae)
rng1.Value = "new value"
End Sub

选项 3

测试=NA()

Sub TestSpecificRegion()
Dim rng1 As Range
Dim rng2 As Range
Dim X
Dim lngRow As Long

On Error Resume Next
' All error formulas in column A
Set rng1 = Columns("A").SpecialCells(xlCellTypeFormulas, 16)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub

'update with new value (could be value or formulae)
For Each rng2 In rng1.Areas
    If rng2.Cells.Count > 1 Then
        X = rng2.Value2
        For lngRow = 1 To UBound(X, 1)
            If X(lngRow, 1) = CVErr(xlErrNA) Then X(lngRow, 1) = "new value"
        Next
        rng2.Value = X
    Else
        If rng2.Value2 = CVErr(xlErrNA) Then rng2.Value = "new value"
    End If
Next

End Sub