Question

在Excel（VBA）中是否可以在1个语句中从筛选列复制/粘贴公式？这有效：

Sheets(1).Range("A2:C" & LastRow).Copy
Sheets(2).Range("A2:C" & Range("D" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteFormulas

但是这会返回混乱的行（可能是因为列被过滤了）：

Sheets(2).Range("A2:C" & Range("D" & Rows.Count).End(xlUp).Row).Formula = Sheets(1).Range("A2:C" & LastRow).Formula

如果可以在不使用剪贴板的情况下在1条声明中做到这一点吗？

修改

在Sheet1中，我将公式添加到A，B和C列：

With Sheets(1)
    LastRow = .Range("D" & Rows.Count).End(xlUp).Row
    .Range("A5:A" & LastRow).Value = "=D5/$A$3*100"
    .Range("A:AG").AutoFilter Field:=22, Criteria1:=">=1/1/2014", Operator:=xlAnd, Criteria2:="<=12/31/2014"
    .Range("B5:B" & LastRow).SpecialCells(xlCellTypeVisible).Value = "=D" & .UsedRange.Offset(5, 0).SpecialCells(xlCellTypeVisible).Row & "/$B$3*100"
    .Range("A:AG").AutoFilter Field:=22, Criteria1:=">=1/1/2015"
    .Range("C5:C" & LastRow).SpecialCells(xlCellTypeVisible).Value = "=D" & .UsedRange.Offset(5, 0).SpecialCells(xlCellTypeVisible).Row & "/$C$3*100"
    .ShowAllData
End With

因此，列A具有公式＆＃34; = Dn / $ A $ 3 * 100，其中n是行号。 B和C公式除以B3和C3细胞值。然后我过滤Sheet1，复制过滤的行并将它们粘贴到Sheet2

Sheets(1).Range("A4:AG" & LastRow).AutoFilter Field:=7, Criteria1:=name
Sheets(1).Range("A5:C" & LastRow).Copy
Sheets(2).Range("A5:C" & Range("D" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteFormulas

Answer 1

这可以完成，但将公式带到另一个工作表会出现问题。公式可以循环拾取，但需要修改单元格地址以反映原始工作表名称。如果应用了Application.ConvertFormula method并且公式转换为严格的 xlAbsolute 样式，则可以检查每个 $ 以查看是否与原始工作表名称的前缀是适当。您提供的公式（例如= D n / $ A $ 3 * 100）相当简单，不应该解析任何问题。

Sub Copy_Filtered_Formulas()
    Dim lr As Long, lc As Long, rVIS As Range
    Dim vr As Long, vc As Long, sFRML As String, p As Long
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")

    With ws2
        If Not IsEmpty(.Cells(5, 1)) Then
            With .Range(.Cells(5, 1), .Cells(Rows.Count, 1).End(xlUp))
                .Resize(.Rows.Count, 3).ClearContents
            End With
        End If
    End With

    With ws1
        If .AutoFilterMode Then .AutoFilterMode = False
        lc = .Range("AG:AG").Column
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        With .Cells(4, 1).Resize(lr - 3, lc)
            With .Offset(1, 0).Resize(.Rows.Count - 1, 3)
                .Formula = "=$D5/A$3*100"
            End With
            .AutoFilter field:=7, Criteria1:=0
            With .Offset(1, 0).Resize(.Rows.Count - 1, 3)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    For Each rVIS In Intersect(.SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeFormulas))
                        sFRML = Application.ConvertFormula(rVIS.FormulaR1C1, xlR1C1, xlA1, xlAbsolute, rVIS)
                        p = InStr(1, sFRML, Chr(36))
                        Do While CBool(p)
                            If Asc(Mid(sFRML, p + 1, 1)) >= 65 And _
                              Asc(Mid(sFRML, p + 1, 1)) <= 90 And _
                              Asc(Mid(sFRML, p - 1, 1)) <> 33 And _
                              Asc(Mid(sFRML, p - 1, 1)) <> 58 Then
                                sFRML = Left(sFRML, p - 1) & Chr(39) & .Parent.Name & Chr(39) & Chr(33) & Mid(sFRML, p, 999)
                                p = InStr(p + Len(.Parent.Name) + 5, sFRML, Chr(36))
                            Else
                                p = InStr(p + 3, sFRML, Chr(36))
                            End If
                        Loop
                        With ws2
                            .Cells(Rows.Count, rVIS.Column).End(xlUp).Offset(1, 0).Formula = sFRML
                        End With
                    Next rVIS
                End If
            End With
        End With
    End With
End Sub

当然，如果您从未打算将原始工作表的名称与公式一起转移，那么很多代码都可以被丢弃。

VBA从过滤柱中粘贴公式

1 个答案: