比较两个过滤的列?

时间:2019-09-17 17:58:16

标签: excel vba loops filtering

我有一个被过滤的电子表格,我需要比较两列的值,如果它们在可见的已过滤单元格中都相同,则执行宏a,如果其中任何一个不同,则执行宏b。

我已经尝试将范围定义为:

Set rng1 = Range("X:X").Cells.SpecialCells(xlCellTypeVisible)

Set rng2 = Range("AU:AU").Cells.SpecialCells(xlCellTypeVisible)

并定义第一个可见范围的值

valE = ActiveSheet.Range("X:X").Cells.SpecialCells(xlCellTypeVisible).Value

valX = ActiveSheet.Range("AU:AU").Cells.SpecialCells(xlCellTypeVisible).Value

我不知道如何编写一个循环,比较下一个可见行,该循环遍历指定范围。我该指什么?

2 个答案:

答案 0 :(得分:0)

Sub REName_()

    Dim r1 As Range, _
            r2 As Range

' your code
Set rng1 = Range("X:X").Cells.SpecialCells(xlCellTypeVisible)
Set rng2 = Range("AU:AU").Cells.SpecialCells(xlCellTypeVisible)
'

    If Ranges_Filtered_Compare_Visible(rng1 , rng2 ) Then
        'a
    Else
        'b
    End If

End Sub

Function Ranges_Filtered_Compare_Visible( _
        r1 As Range, _
        r2 As Range) _
        As Boolean

    Dim wb As Workbook, _
            ws As Worksheet

    Set wb = Workbooks.Add
    Set ws = wb.ActiveSheet

    With ws
        r1.Copy .Cells(1, 1)
        r2.Copy .Cells(1, 2)

        If Columns_next_door_compare(.Cells(1, 1)) Then

            Ranges_Filtered_Compare_Visible = True

        End If
    End With

    wb.Close False

End Function

Function Columns_next_door_compare( _
        ceLL As Range) _
        As Boolean

    Dim r As Range
    Set r = ceLL.CurrentRegion.Columns(1)

    Dim bCells_Equal As Boolean
    bCells_Equal = True

    For Each ceLL In r.Cells

    With ceLL
        If .Value <> .Offset(0, 1).Value Then

            bCells_Equal = False

            Exit For

        End If
    End With

    Next

    Columns_next_door_compare = bCells_Equal

End Function

答案 1 :(得分:0)

Sub Range_Compare_Color( _
    r1 As Range, _
    r2 As Range, _
    lColor As Long)
    ' slowly and solemnly
    ' paint in the first range of a cell that is not in the second

    Dim ceLL As Range

    For Each ceLL In r1

        With ceLL

            If inRange(.Value, r2) = False Then

                .Interior.Color = lColor

            End If
        End With
    Next
End Sub

Function inRange( _
         s As String, _
         r As Range) _
         As Boolean

    Dim found As Range
    Set found = r.Find(s)

    If Not found Is Nothing Then

        inRange = True

    End If
End Function