I am working on a procedure in Excel using VBA that highlights duplicate rows. The procedure evaluates the result of the worksheet function sumproduct to determine if the row has duplicates.
The evaluated formula ends up looking like this:
SUMPRODUCT(--(A1:A10 = A1), --(B1:B10 = B1), --(C1:C10 = C1))
So far the procedure works great, but I need it to disregard hidden rows and columns from the evaluation. I can skip over hidden rows in columns in my loops using Range.Hidden = False
, but I haven't figured out a way to exclude hidden rows and columns from SUMPRODUCT.
I also tried iterating through every row twice using two nested loops and just comparing values two rows at a time, but that开发者_StackOverflow中文版 resulted in N-squared, or O(n2), iterations, so I gave up on that method.
Is there a way to coerce SUMPRODUCT into ignoring hidden rows, as is possible with the spreadsheet formula SUBTOTAL?
Here is what I have so far using Evaluate(SUMPRODUCT)
: Thanks!
Private Sub ShowDuplicateRows()
Dim lngRow As Long
Dim lngColumn As Long
Dim strFormula As String
With Selection
For lngRow = 1 To .Rows.Count
If Not .Rows(lngRow).Hidden Then
strFormula = "SUMPRODUCT("
For lngColumn = 1 To .Columns.Count
If Not .Columns(lngColumn).Hidden Then
If strFormula <> "SUMPRODUCT(" Then
strFormula = strFormula & ", "
End If
strFormula = strFormula _
& "--(" & .Columns(lngColumn).Address _
& " = " & .Cells(lngRow, lngColumn).Address & ")"
End If
Next
strFormula = strFormula & ")"
If Evaluate(strFormula) > 1 Then
.Rows(lngRow).Font.Color = RGB(255, 0, 0)
End If
End If
Next lngRow
End With
End Sub
The RowHeight/Hidden property is not exposed to any formula. The solution will have to be in VBA. One way to accomplish this is to create a User Defined Formula (UDF) that does what you want it to, then just use it in your sumproduct formula.
Public Function IsVisible(ByVal rng As Excel.Range) As Variant
Dim varRtnVal As Variant
Dim lRow As Long, lCol As Long
Dim ws As Excel.Worksheet
ReDim varRtnVal(1 To rng.Rows.Count, 1 To rng.Columns.Count)
For lRow = 1& To rng.Rows.Count
For lCol = 1& To rng.Columns.Count
varRtnVal(lRow, lCol) = CDbl(-(rng.Cells(lRow, lCol).RowHeight > 0&))
Next
Next
IsVisible = varRtnVal
End Function
Then your formula would look like this:
=SUMPRODUCT(IsVisible($A$2:$A$11),--($A$2:$A$11=1),--($B$2:$B$11=1),--($C$2:$C$11=1))
This is the full updated code. First the main procedure, then the user defined function.
If anyone can explain why putting the nested loop in a UDF is faster than having it in the main procedure I would greatly appreciated it! Thanks again to Oorang!
I made my version of the IsVisible UDF a bit more flexible. It can use a range passed as a parameter, or if none is passed it uses Application.Caller
.
Private Sub ShowDuplicateRows()
Dim lngRow As Long
Dim lngColumn As Long
Dim strFormula As String
With Selection
For lngRow = 1 To .Rows.Count
If Not .Rows(lngRow).Hidden Then
strFormula = "SUMPRODUCT(--(ISVISIBLE(" _
& .Columns(1).Address & "))"
For lngColumn = 1 To .Columns.Count
If Not .Columns(lngColumn).Hidden Then
strFormula = strFormula _
& ", --(" & .Columns(lngColumn).Address _
& " = " & .Cells(lngRow, lngColumn).Address & ")"
End If
Next
strFormula = strFormula & ")"
If Evaluate(strFormula) > 1 Then
.Rows(lngRow).Font.Color = RGB(255, 0, 0)
Else
.Rows(lngRow).Font.ColorIndex = xlAutomatic
End If
End If
Next lngRow
End With
End Sub
Public Function IsVisible(Optional ByVal Reference As Range) As Variant
Dim varArray() As Variant
Dim lngRow As Long
Dim lngColumn As Long
If Reference Is Nothing Then Set Reference = Application.Caller
With Reference
ReDim varArray(1 To .Rows.Count, 1 To .Columns.Count)
For lngRow = 1 To .Rows.Count
For lngColumn = 1 To .Columns.Count
varArray(lngRow, lngColumn) _
= Not .Rows(lngRow).Hidden _
And Not .Columns(lngColumn).Hidden
Next lngColumn
Next lngRow
End With
IsVisible = varArray
End Function
精彩评论