VBA过滤柱粘贴配方
有没有在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的公式为“= 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
这可以做，但将公式带到另一个工作表中会出现问题。 公式可以在循环中find，但需要修改单元格地址以反映原始工作表的名称。 如果应用了Application.ConvertFormula方法 ，并且公式被转换为严格的xlAbsolute风格，那么可以检查每个$以查看是否适合使用原始工作表名称。 你提供的公式（例如= D n / $ A $ 3 * 100）相当简单，不应该parsing出任何问题。
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
当然，如果你从来没有打算将原始工作表的名字与公式一起传送，那么很多代码都可以被丢弃。