Entrar Ainda não tem acesso?
Solucionado (ver solução)
Solucionado
(ver solução)
11
respostas

Variável que liga e desliga

Referente ao curso VBA: Automatizando tarefas no Excel

por Felipe Heine
| 34k xp | 10 posts

Estou criando uma macro e gostaria de uma ajudinha de vocês:

-A planilha tem três colunas (ABC); a coluna A tem o mês do documento; na B tem o código do documento e a C tem a modalidade.

-Eu quero pintar cada linha em que os valores da coluna B são iguais, porém a cor da tinta sempre vai alternar entre branco e cinza.

-Eu consegui fazer a macro, porém, eu estou dependendo de uma coluna auxiliar (coluna E). Eu queria fazer sem o apoio dela.

Eu acredito que poderia ser feito algo assim:

-Criar a variável "corAtual", que guarda os valores relativos da cor branca e cinza, sendo o seu valor inicial branca.

-Cria a variável "MudaCor", que verifica se valor da linha acima (coluna B) é diferente da linha atual, se sim vai alterar o valor da variável "corAtual", se não continua pintando com a mesma cor.

Não sei se fui claro, qualquer coisa podemos discutir. Se tiverem uma opção melhor para a macro também agradeço.

Eu upei a planilha que fiz neste link: http://aniteca.zlx.com.br/PAlb

11 respostas
por Rafael Rollo
| 496k xp | 755 posts
Alura Scuba Team Instrutor e Desenvolvedor

Fala Felipe, tudo bem ?

Pelo que vi, você pensou certo .. Mas fica difícil ver o porque não está rolando se não dermos uma olhada no código. Você poderia colocar aqui pra gente dar uma olhada?

Abraço!

por Felipe Heine
| 34k xp | 10 posts

Rafael, o código já está salvo na planilha que mandei o link (será necessário ver a planilha pra entender o código que fiz).

De qualquer forma estarei colocando aqui:

Sub PintaLinhas()
'
'
' Pinta as linhas conforme o código.

Application.ScreenUpdating = False

Dim linha As Integer
Dim linhafim As Integer
linha = 6
linhafim = Range("b1048576").End(xlUp).Row

    Do While linha <= linhafim

        If Cells(linha, 5).Value = 0 Then

            Cells(linha, 1).Select
            Range(Selection, Selection.End(xlToRight)).Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
            linha = linha + 1

        Else

            Cells(linha, 1).Select
            Range(Selection, Selection.End(xlToRight)).Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.149998474074526
            .PatternTintAndShade = 0
            End With
            linha = linha + 1

        End If

    Loop

Application.ScreenUpdating = True

End Sub
por Rafael Rollo
| 496k xp | 755 posts
Alura Scuba Team Instrutor e Desenvolvedor

Não consegui baixar a planilha. Tem algum drive onde possa compartilhar o arquivo ?

por Felipe Heine
| 34k xp | 10 posts

Tenta neste link: https://www.mediafire.com/?d2kucz3kor80r7n

por Eduardo Figueiredo dos Santos
| 219.5k xp | 158 posts
Desenvolvedor Front-End

O que esta coluna auxiliar está fazendo? O que ela auxilia?

por Felipe Heine
| 34k xp | 10 posts

Eduardo, a coluna auxiliar (E) está com a seguinte fórmula do excel: SE(ÉPAR(SE(B7<>B6;E6+1;E6));0;1).

Essa fórmula verifica se o código da linha de cima é diferente da linha atual, se sim, retorna o valor binário (1 ou 0).

Baseando nesse valor binário que a macro está pintando a linha de cinza ou branco, pois veja que no "IF" que utilizei (que postei anteriormente) a condição utilizada é se o valor da célula na coluna E é 0 ( If Cells(linha, 5).Value = 0).

O que eu pretendo fazer é guardar esse valor binário numa variável, para não precisar mais dessa coluna auxiliar, mas não estou conseguindo.

por Eduardo Figueiredo dos Santos
| 219.5k xp | 158 posts
Desenvolvedor Front-End

Na hora do almoço vou baixar sua planilha e tentar entender.

por Eduardo Figueiredo dos Santos
| 219.5k xp | 158 posts
Desenvolvedor Front-End

Me tira uma dúvida aqui. As que forem repetidas ficam cinza e as que não forem ficam branca, é isso?

por Eduardo Figueiredo dos Santos
| 219.5k xp | 158 posts
Desenvolvedor Front-End

Rapaz tenta substituir sua macro por essa:

Sub PintaLinhas()
'
'
' Pinta as linhas conforme o código.

Application.ScreenUpdating = False

Dim linha As Integer
Dim linhafim As Integer
linha = 6
linhafim = Range("b1048576").End(xlUp).Row

    Do While linha <= linhafim
    If (Cells(linha, 2).Value <> Cells(linha - 1, 2).Value) And (Cells(linha, 2).Value <> Cells(linha + 1, 2).Value) Then

        Cells(linha, 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
        linha = linha + 1

    Else

        Cells(linha, 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
        End With
        linha = linha + 1

End If

Loop

Application.ScreenUpdating = True

End Sub
solução!
por Eduardo Figueiredo dos Santos
| 219.5k xp | 158 posts
Desenvolvedor Front-End

Perdão, amigo, antes não estava intercalando as cores. Agora acho que está intercalando. Veja se dá certo isso aí:

Sub PintarCelulas()
'
'
' Pinta as linhas conforme o código.

Application.ScreenUpdating = False

Dim linha As Integer
Dim linhafim As Integer
Dim testeDeCor As Integer

testeDeCor = 0
linha = 6
linhafim = Range("b1048576").End(xlUp).Row

    Do While linha <= linhafim
    If (Cells(linha, 2).Value <> Cells(linha - 1, 2).Value) And (Cells(linha, 2).Value <> Cells(linha + 1, 2).Value) Then
        testeDeCor = testeDeCor + 1
        Cells(linha, 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1

        If testeDeCor Mod 2 <> 0 Then
            .TintAndShade = 0
        Else
            .TintAndShade = -0.149998474074526
        End If

        .PatternTintAndShade = 0
        End With

        linha = linha + 1

    Else
        If Cells(linha, 2).Value <> Cells(linha - 1, 2).Value Then
            testeDeCor = testeDeCor - 1
        End If

        Cells(linha, 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1

        If testeDeCor Mod 2 <> 0 Then
            .TintAndShade = 0
        Else
            .TintAndShade = -0.149998474074526
        End If

        .PatternTintAndShade = 0
        End With
        linha = linha + 1

End If

Loop

Application.ScreenUpdating = True

End Sub
por Felipe Heine
| 34k xp | 10 posts

Funcionou perfeitamente Eduardo, obrigado pela ajuda.