Notifications
Clear all

VBA loop com IF

10 Posts
3 Usuários
0 Reactions
1,408 Visualizações
(@ericksant)
Posts: 0
New Member
Topic starter
 

Prezados,
bom dia,

Tenho uma nova dúvida, acredito que essa é mais fácil...

Preciso fazer uma lógica onde calcule 1 valor menos o valor seguinte, CASO a conta dar 0, ir na outra coluna de Status e marcar nas 2 linhas como "Ok", caso der diferente de 0, marcar como "erro"...

Vejam meu anexo, acredito que ficaria mais fácil o entendimento...

Lembro que há um tempo atrás me ajudaram com um problema parecido com o seguinte código:

Sub conciliar()
On Error Resume Next
Dim ul As Long
'inicio:
ul = Planilha1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To ul
conf1 = CStr(Cells(i, 7).Value & Cells(i, 8).Value)
For j = 2 To ul
If CStr(Cells(j, 7).Value & (Cells(j, 8).Value) * -1) = conf1 And Cells(j, 7).Row <> Cells(i, 7).Row Then
Cells(j, 2).EntireRow.Interior.Color = 65535
Cells(i, 2).EntireRow.Interior.Color = 65535
'GoTo inicio
End If
Next j
Next i
MsgBox "Conciliação realizada com Sucesso!", vbExclamation, "Sucesso!"
End Sub

Obrigado!

 
Postado : 05/06/2018 8:24 am
(@xlarruda)
Posts: 0
New Member
 

Segue:

Sub Status()
Dim ul As Long
ul = Planilha1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To ul
If Planilha1.Range("A" & i).Value + Planilha1.Range("A" & i + 1).Value = 0 Then
Planilha1.Range("B" & i).Value = "OK"
Else
Planilha1.Range("B" & i).Value = "Erro"
End If
Next i
End Sub
 
Postado : 05/06/2018 8:39 am
(@ericksant)
Posts: 0
New Member
Topic starter
 

Fala XlArruda!
Bom dia,

debuguei seu código e ele está quase no objetivo, repare que algumas linhas onde ele tem par mas no status é marcado como Erro, e o certo teria ser como Ok...

Marquei algum deles de verde, como corrigir isso ?

Mais uma vez, muito obrigado cara...

 
Postado : 05/06/2018 8:47 am
(@xlarruda)
Posts: 0
New Member
 

Segue código corrigido:

Sub Status()
Dim ul As Long
inicio:
ul = Planilha1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To ul
If Planilha1.Range("B" & i) <> "OK" And Abs(Planilha1.Range("A" & i).Value) = _
Abs(Planilha1.Range("A" & i + 1).Value) Then
Planilha1.Range("B" & i).Value = "OK"
Planilha1.Range("B" & i + 1).Value = "OK"
End If
Next i
For i = 2 To ul
If Planilha1.Range("B" & i).Value = "" Then
Planilha1.Range("B" & i).Value = "Erro"
End If
Next i
End Sub
 
Postado : 05/06/2018 9:10 am
(@ericksant)
Posts: 0
New Member
Topic starter
 

Cara, você é fera demais!

O estranho é o seguinte, concorda cmg, que ao colocar status 'ok', é porque foi encontrado o par e eles zeraram, logo se eu filtrar só os 'oks' depois que rodar a macro, a soma da coluna tinha que dar 0, pois todos valores se anulam e não é isso que está acontecendo...

Consegue me ajudar nessa ? Só falta isso p fechar...

Mais uma vez OBRIGADO!

 
Postado : 05/06/2018 9:52 am
(@xlarruda)
Posts: 0
New Member
 

Colega ericksant, segue o código corrigido:

Sub Status()
Dim ul As Long
inicio:
ul = Planilha1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To ul
If Planilha1.Range("B" & i) <> "OK" And Planilha1.Range("A" & i).Value = Planilha1.Range("A" & i + 1).Value * -1 Then
Planilha1.Range("B" & i).Value = "OK"
Planilha1.Range("B" & i + 1).Value = "OK"
End If
Next i
For i = 2 To ul
If Planilha1.Range("B" & i).Value = "" Then
Planilha1.Range("B" & i).Value = "Erro"
End If
Next i
End Sub
 
Postado : 05/06/2018 11:14 am
(@ericksant)
Posts: 0
New Member
Topic starter
 

Prezados,
bom dia,

Preciso fazer uma lógica onde calcule 1 valor menos o valor seguinte, CASO a conta dar 0, ir na outra coluna de Status e marcar nas 2 linhas como "Ok", caso der diferente de 0, marcar como "erro"...

Conseguimos chegar em uma solução, porém mesmo zerando a coluna como eu queria, sobraram ainda alguns valores que se casam, vejam meu anexo para melhor entendimento...

Mesmo eu rodando o mesmo código nisso que sobrou, ainda restaram valores que se casam e sem o status de "OK".
No meu arquivo anexado, eu já rodei a macro, se quiser ver os caras que se casam e mesmo assim não estão com Ok, basta retirar o filtro e substituir todos os status por '0'.

Conseguiriam me ajudar ?

 
Postado : 06/06/2018 6:26 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

ericksant

Não crie 2 tópicos sobre o mesmo assunto.
Uni os teus 2 tópicos, agora acesse o link abaixo e veja como funciona a marcação de Resolvido no fórum:

viewtopic.php?f=7&t=16757

Aproveitando acesse os outros links para evitar outros contratempos:
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

[]s

Patropi - Moderador

 
Postado : 06/06/2018 10:15 am
(@ericksant)
Posts: 0
New Member
Topic starter
 

Galera,
boa tarde,

Melhorei o anexo para melhor entendimento...

A um tempo atrás um rapaz me ajudou a fazer o seguinte código para conciliar valores repetidos da mesma coluna, não sei se dá para adpatar para essa nova situação...

ub conciliar()
On Error Resume Next
Dim ul As Long
'inicio:
ul = Planilha1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To ul
conf1 = CStr(Cells(i, 7).Value & Cells(i, 8).Value)
For j = 2 To ul
If CStr(Cells(j, 7).Value & (Cells(j, 8).Value) * -1) = conf1 And Cells(j, 7).Row <> Cells(i, 7).Row Then
Cells(j, 2).EntireRow.Interior.Color = 65535
Cells(i, 2).EntireRow.Interior.Color = 65535
'GoTo inicio
End If
Next j
Next i
MsgBox "Conciliação realizada com Sucesso!", vbExclamation, "Sucesso!"
End Sub

Obrigado!

 
Postado : 08/06/2018 11:05 am
(@ericksant)
Posts: 0
New Member
Topic starter
 

Amigos,
boa tarde,

Consegui resolver com este tópico...
https://www.clubedohardware.com.br/foru ... op-com-if/

Obrigado mesmo assim!

 
Postado : 12/06/2018 1:46 pm