过滤A1中的值

时间:2015-11-10 19:54:17

标签: excel excel-vba formula vba

我试图找出一种方法来过滤C列中A1的值,然后将公式放在第一个单元格中并向下复制。我有下面的代码,但我似乎无法让它工作。我在代码下面有一个电子表格示例。

    With ActiveSheet.Range("A5").CurrentRegion
        .AutoFilter Field:=3, Criteria1:="=RC[1]"
            If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                With .Columns(2)
                .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RC[1]&""-R21"""
                End With
            End If
    End With

enter image description here

2 个答案:

答案 0 :(得分:0)

将范围(" A1")设置为变量

Sub Button2_Click()
    Dim F As Range'declare F as a range
    Set F = Range("A1")'set F as range("A1")
    With ActiveSheet.Range("A5").CurrentRegion
        .AutoFilter Field:=3, Criteria1:=F'Filter for F
        If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            With .Columns(2)
                .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RC[1]&""-R21"""
            End With
        End If
    End With
End Sub

这是另一个版本,因此您不必使用公式。

Sub LoopThroughFilterd()
    Dim rws As Long, rng As Range, Fltr As Range, c As Range

    rws = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("C6:C" & rws)
    Set Fltr = Range("A1")

    Application.ScreenUpdating = 0

    With ActiveSheet.Range("A5").CurrentRegion

        .AutoFilter Field:=3, Criteria1:=Fltr

        For Each c In rng.Cells

            If c.EntireRow.Hidden = 0 Then
                c.Offset(, -1) = c & "-R21"
            End If

        Next c
        .AutoFilter

    End With

End Sub

您也可以循环访问单元格而不是过滤。

Sub LooPFor()
    Dim rws As Long, rng As Range, Fltr As Range, c As Range

    rws = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("C6:C" & rws)
    Set Fltr = Range("A1")

    For Each c In rng.Cells
        If c = Fltr Then c.Offset(, -1) = c & "-R21"
    Next c

End Sub

答案 1 :(得分:0)

我认为问题在于您的公式只会被添加到过滤范围内的第一个单元格中。这是因为像您这样的不连续的SpecialCells范围,即C7,C10,C12:C15等,将由多个Areas组成。如果是这种情况,则需要使用For / Next:

遍历区域
Dim FilteredArea as Range

With ActiveSheet.Range("A5").CurrentRegion
    .AutoFilter Field:=3, Criteria1:="=RC[1]"
    If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
        For Each FilteredArea in .Columns(2).Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Areas
            FilteredArea.FormulaR1C1 = "=RC[1]&""-R21"""
        Next FilteredArea
    End If
End With

这是未经测试的,但希望能让您了解如何使用区域。