Pergunta

Estou trabalhando em um procedimento no Excel usando o VBA que destaca linhas duplicadas. O procedimento avalia o resultado da função da planilha para determinar se a linha possui duplicatas.

A fórmula avaliada acaba parecendo assim:

SUMPRODUCT(--(A1:A10 = A1), --(B1:B10 = B1), --(C1:C10 = C1))

Até agora, o procedimento funciona muito bem, mas preciso que ele desconsidere linhas e colunas ocultas da avaliação. Eu posso pular sobre linhas escondidas em colunas em meus loops usando Range.Hidden = False, mas não descobri uma maneira de excluir linhas e colunas ocultas do SumProduct.

Eu também tentei iterando em todas as fileiras duas vezes usando dois loops aninhados e apenas comparando valores duas linhas por vez, mas isso resultou em n-quadrado, ou O (n (n2), iterações, então desisti desse método.

Existe uma maneira de coagir o Sumproduct a ignorar linhas ocultas, como é possível com a fórmula da planilha subtotal?

Aqui está o que eu tenho até agora usando Evaluate(SUMPRODUCT): Obrigado!

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
Foi útil?

Solução

A propriedade RowHeight/Hidden não está exposta a nenhuma fórmula. A solução terá que estar no VBA. Uma maneira de conseguir isso é criar uma fórmula definida pelo usuário (UDF) que faça o que você deseja e, em seguida, use -a na sua fórmula SUMPRODUCT.

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

Então sua fórmula ficaria assim:

=SUMPRODUCT(IsVisible($A$2:$A$11),--($A$2:$A$11=1),--($B$2:$B$11=1),--($C$2:$C$11=1))

Outras dicas

Este é o código completo atualizado. Primeiro, o procedimento principal, depois a função definida pelo usuário.

Se alguém puder explicar por que colocar o loop aninhado em um UDF é mais rápido do que tê -lo no procedimento principal, eu apreciaria muito! Mais uma vez obrigado a Oorang!

Fiz minha versão do UDF isVisible um pouco mais flexível. Ele pode usar um intervalo passado como um parâmetro, ou se nenhum é passado, ele usa 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
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top