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

Question

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.

Answer 1

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 [e-mail]

Answer 2

https://youtu.be/OweHnQDYMMc

---

A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz [e-mail]

Answer 3

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.

Answer 4

https://youtu.be/k__GdinXyKA

---

A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz [e-mail]

Answer 5

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