Ola Pessoal,
Gostaria da ajuda para melhorar (e muito) uma macro. Ja procurei no forum, encontrei algo parecido mas não consegui fazer funcionar como quero:
Tenho um arquivo de controle de estoque com 9 planilhas. As 7 primeiras são os controles de estoque de 7 linhas de produtos, uma é a pagina principal e a outra planilha de nome CUBO, são dados extraídos do ERP e que através de macros diversas são utilizados para preenchimento das outras 7 planilhas.
pois bem, na planilha CUBO tem uma relação de todos os códigos existentes e o que quero é comparar SE TODOS estes códigos estão nas outras 7 planilhas.
Consegui fazer funcionar com o código abaixo (encontrado na net), mas gostaria de otimiza-lo visto que esta demorando muito.
Nas 7 planilhas a Range onde contem os códigos estão todas nomeadas (uma diferente da outra)
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
Set CompareRange = Range("iCodigos")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosOleo")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosRe")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosRe")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosPneumaticos")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosTransferencia")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosSensores")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosArCondicionado")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosDirecao")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Set CompareRange = Range("iCodigosDiversos")
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
End Sub
Tentei algo assim mas nao funcionou:
Dim r1, r2, r3, CompareRange As Range
Set r1 = Worksheets("Plan1").Range("iCodigos")
Set r2 = Worksheets("plan2").Range("iCodigosOleo")
Set r3 = Worksheets("Plan3").Range("iCodigosRe")
Set CompareRange = Union(r1, r2, r3)
For Each x In Range("L3:L500")
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Postado : 04/11/2014 7:39 pm