Notifications
Clear all

problema com loop

4 Posts
3 Usuários
2 Likes
1,000 Visualizações
(@cimerio)
Posts: 47
Trusted Member
Topic starter
 

basicamente, é uma forma de verificar os cnpjs que surgiram como clientes novos.

pra mim, eu tinha imaginado um paradigma certo, mas o loop pára qd encontra o primeiro teste.

 

anexei a planilha e o código.

 
Postado : 02/10/2020 11:01 am
Raygsson
(@raygsson)
Posts: 68
Trusted Member
 

o paradigma do seu código não estava bom, comparava apenas os CNPJ das colunas B e J estando na mesma linha. Se o CNPJ da coluna B estiver em uma linha diferente na coluna J não encontraria e a partir dai não acharia mais nada. Fiz um rascunho pra marcar OK quando achar, pode prosseguir deste ponto:

Planilha1.Activate
For n = 2 To 180
For y = 2 To 170
If Cells(n, 2) = Cells(y, 10) Then
Cells(y, 11) = "ok"
End If
Next
Next
 
Postado : 02/10/2020 2:36 pm
cimerio reacted
(@cimerio)
Posts: 47
Trusted Member
Topic starter
 

obr raygsson, resolveu meu problema.

 
Postado : 07/10/2020 11:24 am
Mauro Coutinho
(@coutinho)
Posts: 95
Estimable Member
 

@cimerio apesar de ja ter tido uma resposta que ajudou, segue uma outra alternativa, eu ia postar no dia que vi, mas esse post sumiu e agora reapareceu.

O que ela faz, ao ser executada será listado na coluna C todos os valores da Lista1 que não constam na Lista2 e vice e versa, então antes de executar veja se as colunas C e K não contem nenhum dado porque serão substituídos.

Option Explicit

Sub ValoresUnicos()
Dim rngCell As Range
Dim LinhaFinal
Dim rngCellB As Range
Dim rngCellJ As Range

LinhaFinal = Worksheets("Planilha1").Range("B1048576").End(xlUp).Row

Set rngCellB = Range("B2" & ":B" & LinhaFinal)
Set rngCellJ = Range("J2" & ":J" & LinhaFinal)

For Each rngCell In rngCellB
If WorksheetFunction.CountIf(rngCellJ, rngCell) = 0 Then
Range("C" & Rows.Count).End(xlUp).Offset(1) = rngCell
End If
Next

For Each rngCell In rngCellJ
If WorksheetFunction.CountIf(rngCellB, rngCell) = 0 Then
Range("K" & Rows.Count).End(xlUp).Offset(1) = rngCell
End If
Next

End Sub

Mauro Coutinho
 
Postado : 07/10/2020 4:03 pm
cimerio reacted