Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Executar somente nas células Visíveis (Auto Filtro)

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Mathmatic
Manda bem
Manda bem
Mensagens: 184
Registrado em: Seg Out 24, 2011 1:50 pm

Executar somente nas células Visíveis (Auto Filtro)

Mensagem por Mathmatic »

Saudações,
preciso de um código VBA que opere somente nas células Visíveis da Plan1 (após o Auto Filtro).

precisa fazer o seguinte (após o Auto Filtro).

o código vba deverá localizar na coluna A valores repetidos; Ao encontrar valor repetido, então deverá verificar na coluna B e também na coluna C (na mesma linha correspondente que encontrou o valor repetido) se o valor da Col B e da Col C são maiores que zero (> 0), Então se ambos (col B e col C) forem maior que zero, deverá escrever na coluna D (na mesma linha correspondente) a seguinte palavra: "Concluído".


desde já agradeço aos senhores


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


srobles
Jedi
Jedi
Mensagens: 805
Registrado em: Qua Mai 06, 2015 7:39 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por srobles »

Mathmatic,

Não sei se entendi, mas segue abaixo um esboço :

Código: Selecionar todos

Sub validarDados()
    With ThisWorkbook.Sheets("Plan1")
        .Activate
        'Classificamos os dados com base na coluna A
        Dim ultimaLinha As Integer
        ultimaLinha = .UsedRange.Rows.Count
        Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range("A2:A" & ultimaLinha), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Plan1").Sort
            .SetRange Range("A1:D" & ultimaLinha)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Range("A1").Select
        
        'Buscamos pelos valores repetidos e validamos
        Cells(2, "A").Select
        For a = 2 To .UsedRange.Rows.Count
            Cells(a, "A").Select
            If Cells(a + 1, "A") = Cells(a, "A") Then
                If Cells(a, "B") > 0 And Cells(a, "C") > 0 Then
                    Cells(a, "D") = "Concluído"
                Else
                    Cells(a, "D") = ""
                End If
            Else
                If Cells(a, "B") > 0 And Cells(a, "C") > 0 Then
                    Cells(a, "D") = "Concluído"
                Else
                    Cells(a, "D") = ""
                End If
            End If
        Next
    End With
End Sub
Abs


Mathmatic
Manda bem
Manda bem
Mensagens: 184
Registrado em: Seg Out 24, 2011 1:50 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por Mathmatic »

sr. srobles,

Teria como "simplificar" o código para funcionar sem a pré-classificação da coluna A ?

ou seja, não gostaria de classificar a planilha, e sim somente localizar os valores duplicados na Col A e apartir daí então seguir os critérios da Col B e Col C.


srobles
Jedi
Jedi
Mensagens: 805
Registrado em: Qua Mai 06, 2015 7:39 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por srobles »

Mathmatic,

Refiz o código, e assim como o anterior (percebi agora), não consegui validar com base nas células visíveis apenas. Porém, este não necessita de classificação de dados. Se lhe ajudar...

Código: Selecionar todos

Sub validarDados()
    With ThisWorkbook.Sheets("Plan1")
        .Activate
        Cells(2, "A").Select
       'Retornamos a ultima linha preenchida
        Dim ultimaLinha As Integer
        ultimaLinha = .UsedRange.Rows.Count
        'Laço For=> Next para verificar linha a linha
        For a = 2 To ultimaLinha
            Dim procItem As String
                    'Armazenamos o valor da celula ativa para verificarmos com as demais
                    procItem = Cells(a, "A")
                        'Laço For=>Next para compararmos a variável com as linhas subsequentes
                        For b = a To ultimaLinha
                            'Se o valor da variável for igual ao da célula atual
                            If Cells(a, "A") = Cells(b, "A") Then
                                'Se os valores da coluna B e C forem maiores que 0 (zero)
                                If Cells(b, "B") > 0 And Cells(b, "C") > 0 Then
                                    'Adicionamos Concluído na coluna D
                                    Cells(b, "D") = "Concluído"
                                End If
                            End If
                        Next
        Next
    End With
End Sub
Abs


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Mathmatic
Manda bem
Manda bem
Mensagens: 184
Registrado em: Seg Out 24, 2011 1:50 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por Mathmatic »

sr. srobles,

obrigado pelo esforço em querer ajudar.

este código já ajudará bastante.

Talvez alguém aqui no fórum consiga adaptá-lo para operar em células Visíveis !


Wagner.cwb
Manda bem
Manda bem
Mensagens: 168
Registrado em: Sáb Set 24, 2016 4:48 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por Wagner.cwb »

Se puder disponibilizar a planilha, talvez eu tenha uma ideia de como ajudar. abs!


Mathmatic
Manda bem
Manda bem
Mensagens: 184
Registrado em: Seg Out 24, 2011 1:50 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por Mathmatic »

senhores,

segue um modelo simplificado em anexo.

observei que o código do sr. srobles, opera corretamente somente para o caso de haver valores negativos na coluna B ou C (que são restrições secundárias para Não escrever a palavra "Concluído" na coluna D).

Mas o código não atende o caso de precisar ser valor duplicado na coluna A (restrição primária), ou seja, no modelo em anexo coloquei dois nomes não repetidos ( Carlos e João), mas o código escreveu a palavra "Concluído" mesmo assim; Sendo que não deveria ter escrito por não ser valor repetido na coluna A.

Obs: É de estrema importância que o código opere em células Visíveis (pois existem células filtradas).
Anexos
duplicados.rar
(11.16 KiB) Baixado 213 vezes


srobles
Jedi
Jedi
Mensagens: 805
Registrado em: Qua Mai 06, 2015 7:39 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por srobles »

Mathmatic,

Conforme solicitado no post , veja se o código abaixo te ajuda. Testei aqui e funcionou, e o melhor, só em células visiveis.

Código: Selecionar todos

Sub validarDados()
    With ThisWorkbook.Sheets("Plan2")
        .Activate
        Cells(2, "A").Select
       'Retornamos a ultima linha preenchida
        Dim ultimaLinha As Integer
        ultimaLinha = .UsedRange.Rows.Count
        'Laço For=> Next para verificar linha a linha
        For a = 2 To ultimaLinha
            Dim procItem As String
            Cells(a, "A").Select
                    'Armazenamos o valor da celula ativa para verificarmos com as demais
                    procItem = Cells(a, "A")
                        'Laço For=>Next para compararmos a variável com as linhas subsequentes
                        For b = a + 1 To ultimaLinha
                            Cells(b, "A").Select
                            'Se o valor da variável for igual ao da célula atual
                            If Cells(a, "A") = Cells(b, "A") Then
                                If Cells(b, "D") = "Concluído" Then Exit For
                                'Se os valores da coluna B e C forem maiores que 0 (zero)
                                If Cells(b, "B") > 0 And Cells(b, "C") > 0 And Selection.EntireRow.Hidden = False Then
                                    'Adicionamos Concluído na coluna D
                                    Cells(b, "D") = "Concluído"
                                    Exit For
                                Else
                                End If
                            End If
                        Next
        Next
    End With
End Sub
Abs


Mathmatic
Manda bem
Manda bem
Mensagens: 184
Registrado em: Seg Out 24, 2011 1:50 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por Mathmatic »

sr. srobles,

Parabéns pelo seu esforço e conhecimento !

o seu código ficou muito bom.

detalhe:

observei que o código não considera (não valida) o primeiro nome da lista (col A), mesmo que existe repetição do nome nas linhas seguintes abaixo dele.

testei aqui e tudo funcionou bem, Mas não considerou o primeiro nome "CICLANO" (primeira ocorrência), ou seja, é como se tivesse passado por ele sem vê-lo, somente os outros CICLANOS seguintes foram observados pelo código.

acho que o código fez uma varredura somente para cima do valor analisado, testei para outros casos, e sempre o primeiro nome (primeira ocorrência) não é considerado, mesmo que haja repetições logo abaixo do mesmo.


muito obrigado por sua atenção.


srobles
Jedi
Jedi
Mensagens: 805
Registrado em: Qua Mai 06, 2015 7:39 pm

Re: Executar somente nas células Visíveis (Auto Filtro)

Mensagem por srobles »

Mathmatic,

Opa meu amigo, obrigado pelo comentário e reconhecimento. Obrigado mesmo!

Estudei mais um pouco o código e fiz uma pequena alteração, que creio, irá resolver seu problema. Não houve mais a ocorrência de ignorar o 1º nome da lista.

Substitua o código que passei anteriormente pelo que segue abaixo :

Código: Selecionar todos

Sub validarDados()
    'Altere o nome da aba caso necessite
    With ThisWorkbook.Sheets("Plan1")
        .Activate
        Cells(2, "A").Select
       'Retornamos a ultima linha preenchida
        Dim ultimaLinha As Integer
        ultimaLinha = .UsedRange.Rows.Count
        'Laço For=> Next para verificar linha a linha
        For a = 2 To ultimaLinha
            Dim procItem As String
            Cells(a, "A").Select
                    'Armazenamos o valor da celula ativa para verificarmos com as demais
                    procItem = Cells(a, "A")
                        'Laço For=>Next para compararmos a variável com as linhas subsequentes
                        For b = a To ultimaLinha
                            Cells(b, "A").Select
                            'Se o valor da variável for igual ao da célula atual
                            If Cells(a, "A") = Cells(b, "A") Then
                                If Cells(b, "D") = "Concluído" Then Exit For
                                'Se os valores da coluna B e C forem maiores que 0 (zero) e a linha estiver visivel
                                If Cells(b, "B") > 0 And Cells(b, "C") > 0 And Selection.EntireRow.Hidden = False Then
                                    'Adicionamos Concluído na coluna D
                                    Cells(b, "D") = "Concluído"
                                    Exit For
                                Else
                                End If
                            End If
                        Next
        Next
    End With
End Sub
Abs


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder