比较两个过滤列?



我有一个经过过滤的电子表格,我需要比较两列的值,如果它们在可见过滤单元格中都相同,则执行宏 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

我不知道如何编写一个循环来迭代指定的范围,比较下一个可见行。我应该参考什么?

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
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

最新更新