如何复制公式结果

Question

如何复制公式结果？

我 select 要在工作表“UI”中保留哪些行，方法是在 B 列中标记值为 1 的行。

我将以下宏分配给一个命令按钮，它将 selected 行复制到工作表“输出”：

Private Sub CommandButton1_Click()
    
    Dim i As Integer
    Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("UI")
    Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Output")
    
    For i = 2 To ws1.Range("B999").End(xlUp).Row
        If ws1.Cells(i, 2) = "1" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
    Next i
End Sub

由于行中的值是公式的结果，粘贴到“输出”中的结果作为无效的单元格引用返回。

有没有复制粘贴文本的方法？

Answer 1

当行中的值是公式的结果时，您应该使用“xlPasteValues”属性以避免无效的单元格引用。您可以尝试修改您的代码如下：

Private Sub CommandButton1_Click()
    
    Dim i As Integer
    Dim ws1 As Worksheet: Set ws1 = Sheets("UI")
    Dim ws2 As Worksheet: Set ws2 = Sheets("Output")
    
    For i = 2 To ws1.Range("B999").End(xlUp).Row
        If ws1.Cells(i, 2) = "1" Then
             ws1.Rows(i).Copy
             ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
        End If
    Next i
    
End Sub

Answer 2

复制带条件的行的值

虽然不漂亮，但很有效。
调整常量部分中的值。

代码

Option Explicit

Private Sub CommandButton1_Click()
    
    ' Source
    Const sName As String = "UI"
    Const sFirstRow As Long = 2
    Const Criteria As String = "1" ' 'Const Criteria as long = 1'?
    ' Destination
    Const dName As String = "Output"
    Const dCell As String = "A2"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook

    ' Define Source Range (assuming 'UsedRange' starts in cell 'A1').
    Dim rg As Range: Set rg = wb.Worksheets(sName).UsedRange
    
    ' Write values from Source Range to Data Array.
    Dim Data As Variant: Data = rg.Value ' assuming 'rg' has at least two cells
    Dim cCount As Long: cCount = UBound(Data, 2)
    
    ' Declare additional variables.
    Dim cValue As Variant
    Dim i As Long, j As Long, k As Long
    
    ' Loop and write matching values to the beginning of Data Array.
    For i = sFirstRow To UBound(Data, 1)
        cValue = Data(i, 2)
        If Not IsError(cValue) Then
            If cValue = Criteria Then
                k = k + 1
                For j = 1 To cCount
                    Data(k, j) = Data(i, j)
                Next j
            End If
        End If
    Next i
     
    ' Write matching values from Data Array to Destination Range.
    If k > 0 Then
        With wb.Worksheets(dName).Range(dCell)
            .Resize(.Worksheet.Rows.Count - .Row + 1, _
                .Worksheet.Columns.Count - .Column + 1).ClearContents
            .Resize(k, cCount).Value = Data
        End With
        MsgBox "Data transferred.", vbInformation, "Success"
    Else
        MsgBox "No matches found.", vbExclamation, "Fail?"
    End If

End Sub

如何复制公式结果

How to copy formula result

excel

vba

copy-paste

复制带条件的行的值