Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Localizar uma sequê...
 
Notifications
Clear all

Localizar uma sequência númerica com uma Macro

 
2024 - VBA & Macros
Post Recente por ruymds 8 anos atrás
3 Posts
2 Usuários
0 Reactions
857 Visualizações
RSS
 ruymds
(@ruymds)
Posts: 6
Active Member
Topic starter
 

Olá pessoal,

Possuo uma macro que localiza uma sequência de 15 números que estão dispostos em colunas. No entanto, ele só funciona a primeira vez que executo a pesquisa, se entro com outra sequência o mesmo não executa.

Segue o código e o link da planilha para análise.

Sub procura()

Dim w As Worksheet, t As Long, j As Long
Set w = Plan1

t = w.Cells(Cells.Rows.Count, 1).End(xlUp).Row
If w.ProtectContents = True Then Exit Sub

If w.AutoFilterMode = True Then

w.AutoFilterMode = False
End If

Application.ScreenUpdating = False
DoEvents

For I = 3 To t
j = 0
For c = 1 To 15
If w.Cells(I, c) = w.Cells(3, c + 17) Then
j = j + 1

If j = 15 Then

w.Range("a" & I, "o" & I).Interior.Color = 255
Exit Sub
End If

End If

Next c

Next I
Application.ScreenUpdating = True

End Sub

https://drive.google.com/open?id=0B_ABUoMQVpIeZ05zSldvVVVQM3M

Grato se alguém puder me esclarecer o que está havendo.

 
Postado : 25/11/2016 11:45 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Aparentmente a variavel t estava assuminto o valor 3, então qualquer sequencia depois da terceira linha não será encontrada
Experimente:

Sub procura()
Dim w As Worksheet
Dim I As Long, J As Integer, C As Integer
Set w = Plan1

't = w.Cells(Cells.Rows.Count, 1).End(xlUp).Row
If w.ProtectContents = True Then Exit Sub

If w.AutoFilterMode = True Then w.AutoFilterMode = False

Application.ScreenUpdating = False
'DoEvents
I = 3
Do While w.Cells(I, 1) <> "" 'For i = 3 To t
    J = 0
    For C = 1 To 15
        If w.Cells(I, C) = w.Cells(3, C + 17) Then
            J = J + 1
        
            If J = 15 Then
                w.Range("a" & I, "o" & I).Interior.Color = 255
                Exit Sub
            End If
        End If
    Next C
I = I + 1
Loop 'Next i
Application.ScreenUpdating = True
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 25/11/2016 1:17 pm
 ruymds
(@ruymds)
Posts: 6
Active Member
Topic starter
 

Grato Reinaldo pela ajuda.

 
Postado : 25/11/2016 2:14 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico