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

Ajuda com For Each

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
carlosescudeiro
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Qua Set 21, 2016 2:53 pm

Ajuda com For Each

Mensagem por carlosescudeiro »

Ola a todos
Estou com uma dificuldade em pegar valores de celulas comparadas pelo For Each e popular outras celulas com seus valores relacionados.
O resultado me retorna n valores, pelo offset consigo os valores retornados, mas preciso dos valores das celuas a direita
ex:
Os resultados de A1:A10 preciso colar em outra planilha B5:B15.

Segue meu codigo

Código: Selecionar todos

Sub Find_Matches()
    Dim CompareRange As Variant, x As Variant, y As Variant
    
    Set CompareRange = Sheets("Relogio").Range("d5:d99")
    
    For Each x In Sheets("Espelho").Range("a5:a39")
        For Each y In CompareRange
            If x = y Then
            x.Offset(0, 17) = x ' Aqui mostram os valores achados e copiados pelo offset
                'preciso pegar os valores de celulas e colar em outra
                'celula de destino = x.Offset(0, 3).Value
                End If
            End If
        Next y
    Next x
End Sub


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.


Avatar do usuário
Mauro Coutinho
Jedi
Jedi
Mensagens: 1561
Registrado em: Sáb Mar 13, 2010 8:10 pm
Localização: São José dos Pinhais - Pr

Re: Ajuda com For Each

Mensagem por Mauro Coutinho »

A sua rotina já retorna os valores para a Sheets("Espelho"), agora se quer uma terceira aba e como não citou para quais ranges, estou supondo que irá retornar para uma coluna somente, se for isto utilize a rotina abaixo.

Código: Selecionar todos

Sub Find_Matches_Mauro()
    Dim CompareRange As Variant, x As Variant, y As Variant
    Dim shRetorno As Worksheet
    
    Dim i
    i = 2
    
    'Aba a ser inserido os valores, ajuste o nome da aba
    Set shRetorno = Worksheets("Plan3")
    
    Set CompareRange = Sheets("Relogio").Range("d5:d99")
   
    For Each x In Sheets("Espelho").Range("a5:a39")
        
        For Each y In CompareRange
            
            If x = y Then
                x.Offset(0, 2) = x ' Aqui mostram os valores achados e copiados pelo offset
                'preciso pegar os valores de celulas e colar em outra
                'celula de destino = x.Offset(0, 3).Value
                
                'Aba para o retorno
                shRetorno.Cells(i, 3) = x
                i = i + 1
                
                End If
           
        Next y
        
    Next x
    
End Sub
[]s


Responder