none
Como criar um código que localiza a célula pelo seu conteúdo e escreve na célula abaixo um determinado valor ? RRS feed

  • Pergunta

  • Olá. Boa noite. Quem puder me ajudar com o código vba para a resolução do meu problema abaixo desde já meu muito obrigado:

    Criei uma planilha para especificar nela o preço de cada peça de acordo com o modelo de lavadora que ela pertence. Só que muitas vezes a mesma peça também se aplica a vários outros modelos. Como posso fazer o Excel, via código, fazer isso automaticamente bastando apenas eu passar para ele os modelos nos quais abaixo dessas células ele insira o valor que especifiquei previamente?  Por exemplo são 256 modelos especificados em cada célula na primeira linha superior. Desses 256 modelos 60 utilizam a mesma peça que custa R$70,00. Para eu não ter que ficar 60 vezes procurando cada modelo na linha e digitando R$70,00 na célula correspondente abaixo precisarei de um código que faça isso por mim. Ele irá inserir R$70,00 na célula abaixo de todas as células que contiverem os seguintes modelos por exemplo: 

    BWB08ABANA
    BWB08ABBNA
    BWB11ABANA
    BWB11ABBNA
    BWC06ABANA

    . . .

    Se eu pudesse especificar a linha que ele escreveria o valor melhor ainda pois há outras peças abaixo do agitador para fazer o mesmo.

    terça-feira, 21 de julho de 2020 22:46

Respostas

  • Sub PREENCHERVALOR()
    
        Application.ScreenUpdating = False
    
        Dim LINHAPLAN1 As Long
        Dim LINHAPLAN2 As Long
        Dim COLUNAPLAN2 As Long
        Dim COLUNAPLAN1 As Long
        Dim CELULAVALOR As Object
        Dim INTERVALOLIMPAR As Range
    
        For Each CELULAVALOR In Plan1.UsedRange.Cells
    
            If CELULAVALOR.Row > 1 Then
    
                If CELULAVALOR.Column > 1 Then
    
                    If Not INTERVALOLIMPAR Is Nothing Then
    
                      Set INTERVALOLIMPAR = Union(INTERVALOLIMPAR, Range(CELULAVALOR.Address))
    
                    Else
    
                      Set INTERVALOLIMPAR = Range(CELULAVALOR.Address)
    
                    End If
    
                End If
    
            End If
    
    
        Next CELULAVALOR
        
        If Plan1.Name = ActiveSheet.Name Then
        
        INTERVALOLIMPAR.ClearContents
    
    End If
    
        LINHAPLAN1 = 2
    
        While Plan1.Range("A" & LINHAPLAN1).Value <> ""
    
    
    
            LINHAPLAN2 = 2
    
            While Plan2.Range("A" & LINHAPLAN2).Value <> ""
    
    
    
                COLUNAPLAN2 = 3
    
                While Plan2.Cells(LINHAPLAN2, COLUNAPLAN2).Value <> ""
    
    
                    COLUNAPLAN1 = 2
    
                    While Plan1.Cells(1, COLUNAPLAN1).Value <> ""
    
                        If Plan2.Cells(LINHAPLAN2, COLUNAPLAN2).Value = Plan1.Cells(1, COLUNAPLAN1).Value Then
    
                            If Plan2.Cells(LINHAPLAN2, 1).Value = Plan1.Cells(LINHAPLAN1, 1).Value Then
    
                                Plan1.Cells(LINHAPLAN1, COLUNAPLAN1).Value = Plan2.Cells(LINHAPLAN2, 2).Value
    
                            End If
    
                        End If
    
                        COLUNAPLAN1 = COLUNAPLAN1 + 1
    
    
                    Wend
    
    
                    COLUNAPLAN2 = COLUNAPLAN2 + 1
    
    
                Wend
    
    
    
    
    
                LINHAPLAN2 = LINHAPLAN2 + 1
    
    
            Wend
    
    
    
            LINHAPLAN1 = LINHAPLAN1 + 1
    
    
        Wend
    
    
    
    
    
        Application.ScreenUpdating = True
    
    
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 22 de julho de 2020 18:11
    • Marcado como Resposta deverton1818 quinta-feira, 23 de julho de 2020 17:56
    quarta-feira, 22 de julho de 2020 18:11

Todas as Respostas

  • Sub PREENCHERVALOR()
    
        Application.ScreenUpdating = False
    
        Dim LINHAPLAN1 As Long
        Dim LINHAPLAN2 As Long
        Dim COLUNAPLAN2 As Long
        Dim COLUNAPLAN1 As Long
        Dim CELULAVALOR As Object
        Dim INTERVALOLIMPAR As Range
    
        For Each CELULAVALOR In Plan1.UsedRange.Cells
    
            If CELULAVALOR.Row > 1 Then
    
                If CELULAVALOR.Column > 1 Then
    
                    If Not INTERVALOLIMPAR Is Nothing Then
    
                      Set INTERVALOLIMPAR = Union(INTERVALOLIMPAR, Range(CELULAVALOR.Address))
    
                    Else
    
                      Set INTERVALOLIMPAR = Range(CELULAVALOR.Address)
    
                    End If
    
                End If
    
            End If
    
    
        Next CELULAVALOR
        
        If Plan1.Name = ActiveSheet.Name Then
        
        INTERVALOLIMPAR.ClearContents
    
    End If
    
        LINHAPLAN1 = 2
    
        While Plan1.Range("A" & LINHAPLAN1).Value <> ""
    
    
    
            LINHAPLAN2 = 2
    
            While Plan2.Range("A" & LINHAPLAN2).Value <> ""
    
    
    
                COLUNAPLAN2 = 3
    
                While Plan2.Cells(LINHAPLAN2, COLUNAPLAN2).Value <> ""
    
    
                    COLUNAPLAN1 = 2
    
                    While Plan1.Cells(1, COLUNAPLAN1).Value <> ""
    
                        If Plan2.Cells(LINHAPLAN2, COLUNAPLAN2).Value = Plan1.Cells(1, COLUNAPLAN1).Value Then
    
                            If Plan2.Cells(LINHAPLAN2, 1).Value = Plan1.Cells(LINHAPLAN1, 1).Value Then
    
                                Plan1.Cells(LINHAPLAN1, COLUNAPLAN1).Value = Plan2.Cells(LINHAPLAN2, 2).Value
    
                            End If
    
                        End If
    
                        COLUNAPLAN1 = COLUNAPLAN1 + 1
    
    
                    Wend
    
    
                    COLUNAPLAN2 = COLUNAPLAN2 + 1
    
    
                Wend
    
    
    
    
    
                LINHAPLAN2 = LINHAPLAN2 + 1
    
    
            Wend
    
    
    
            LINHAPLAN1 = LINHAPLAN1 + 1
    
    
        Wend
    
    
    
    
    
        Application.ScreenUpdating = True
    
    
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 22 de julho de 2020 18:11
    • Marcado como Resposta deverton1818 quinta-feira, 23 de julho de 2020 17:56
    quarta-feira, 22 de julho de 2020 18:11
  • https://youtu.be/OweHnQDYMMc

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 22 de julho de 2020 19:21
    quarta-feira, 22 de julho de 2020 19:21
  • Meu querido super gente boa. Muito agradecido mesmo pela sua extrema gentileza de além do código até ter feito um vídeo para mim explicando. Vou adaptar aqui na minha planilha para minha situação porque acontece o seguinte por exemplo aqui no meu caso:  Digamos que a PEÇA1 seja a tampa da lavadora. Pois bem, da mesma forma que existem diversos modelos de lavadoras cada qual com suas características também existem diversas tampas cada qual com suas características e preços diferentes. Então no meu caso a PEÇA1 tem sempre o preço X para alguns modelos de lavadoras, o preço Y para outros modelos, o preço Z para outras e assim por diante. E a mesma coisa acontece em relação as outras peças. Dei a elas um nome genérico para quando eu for na casa do cliente consertar a lavadora dele independente da característica da peça eu possa consultar o preço da mesma em relação ao modelo especifico de sua lavadora. Acho que só terei que tirar a função de limpar as células para que após eu atualizar a plan2 com outro valor para a peça e outros modelos onde esse novo valor será aplicado o código mantenha o que ele já havia feito estou certo?

    Qual linha de código eu incluo para que caso ocorra de eu atualizar uma célula preenchida o código só atualize a célula se o novo preço for maior que o anterior?

    Estou com medo de você falar: dei a mão para o cara e ele quer o corpo inteiro rsrsrs.

    Mas beleza. Do jeito que você fez  este código já me ajudou muitão mesmo fiquei muito feliz.


    • Editado deverton1818 quinta-feira, 23 de julho de 2020 13:12 acrescimo de informações
    quinta-feira, 23 de julho de 2020 01:33
  • https://youtu.be/k__GdinXyKA

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    quinta-feira, 23 de julho de 2020 18:00
  • Muito obrigado. Já consegui fazer as adaptações :)

    Sub PREENCHERVALOR()
    
        Application.ScreenUpdating = False
    
        Dim LINHAPLAN1 As Long
        Dim LINHAPLAN2 As Long
        Dim COLUNAPLAN2 As Long
        Dim COLUNAPLAN1 As Long
    
        
        If Plan1.Name = ActiveSheet.Name Then
        
        
    
    End If
    
        LINHAPLAN1 = 2
    
        While Plan1.Range("A" & LINHAPLAN1).Value <> ""
    
    
    
            LINHAPLAN2 = 2
    
            While Plan2.Range("A" & LINHAPLAN2).Value <> ""
    
    
    
                COLUNAPLAN2 = 3
    
                While Plan2.Cells(LINHAPLAN2, COLUNAPLAN2).Value <> ""
    
    
                    COLUNAPLAN1 = 2
    
                    While Plan1.Cells(1, COLUNAPLAN1).Value <> ""
    
                        If Plan2.Cells(LINHAPLAN2, COLUNAPLAN2).Value = Plan1.Cells(1, COLUNAPLAN1).Value Then
    
                            If Plan2.Cells(LINHAPLAN2, 1).Value = Plan1.Cells(LINHAPLAN1, 1).Value Then
    							'A linha a seguir só atualiza o preço em Plan1 se o novo preço adicionado em Plan2 for maior.
                                If Plan2.Cells(LINHAPLAN2, 2).Value > Plan1.Cells(LINHAPLAN1, COLUNAPLAN1).Value Then
    
                                    Plan1.Cells(LINHAPLAN1, COLUNAPLAN1).Value = Plan2.Cells(LINHAPLAN2, 2).Value
                                    
                                End If
    
                            End If
    
                        End If
    
                        COLUNAPLAN1 = COLUNAPLAN1 + 1
    
    
                    Wend
    
    
                    COLUNAPLAN2 = COLUNAPLAN2 + 1
    
    
                Wend
    
    
    
    
    
                LINHAPLAN2 = LINHAPLAN2 + 1
    
    
            Wend
    
    
    
            LINHAPLAN1 = LINHAPLAN1 + 1
    
    
        Wend
    
    
    
    
    
        Application.ScreenUpdating = True
    
    
    End Sub

    quinta-feira, 23 de julho de 2020 18:08