romainchu78
XLDnaute Occasionnel
Re-bonjour,
J'ai cree cette macro excel. elle permet de definir un status sur des references de pieces.
J'ai 2 colonnes A et B. En A la provenance des references et en B la reference.
Les references proviennent de 2 sources differentes donc il y a deux types de valeurs dans la colonne A.
Le but: Dire si chacune des references issuent issue de la source "vpm" sont aussi presentent dans la source "doc". Si c'est le cas, mettre un mot el colonne C sur la meme ligne de la reference concernee et mettre de la couleur sur la ligne concernee.
ma macro fonctionne. le probleme est qu'elle n'est pas optimisee et la compilation prend 10 ou 15 min pour plus de 16000 lignes a compiler.
Quelqu'un peut-il m'aider a l'obtimiser.
Sub test()
Application.ScreenUpdating = False
For I = 1 To Range("B1").End(xlDown).Row
If Cells(I, 1).Value = "" Then
GoTo fin
End If
For J = I + 1 To Range("B1").End(xlDown).Row
If Cells(I, 2).Value = Cells(J, 2).Value And Cells(I, 1).Value = "vpm" Then
Cells(I, 2).Font.ColorIndex = 50
Cells(I, 3).Value = "|"
Cells(I, 4).Value = "In DocQuest"
GoTo FIN2
End If
Next J
FIN2:
Next I
fin:
Application.ScreenUpdating = True
End Sub
Merci par avance
J'ai cree cette macro excel. elle permet de definir un status sur des references de pieces.
J'ai 2 colonnes A et B. En A la provenance des references et en B la reference.
Les references proviennent de 2 sources differentes donc il y a deux types de valeurs dans la colonne A.
Le but: Dire si chacune des references issuent issue de la source "vpm" sont aussi presentent dans la source "doc". Si c'est le cas, mettre un mot el colonne C sur la meme ligne de la reference concernee et mettre de la couleur sur la ligne concernee.
ma macro fonctionne. le probleme est qu'elle n'est pas optimisee et la compilation prend 10 ou 15 min pour plus de 16000 lignes a compiler.
Quelqu'un peut-il m'aider a l'obtimiser.
Sub test()
Application.ScreenUpdating = False
For I = 1 To Range("B1").End(xlDown).Row
If Cells(I, 1).Value = "" Then
GoTo fin
End If
For J = I + 1 To Range("B1").End(xlDown).Row
If Cells(I, 2).Value = Cells(J, 2).Value And Cells(I, 1).Value = "vpm" Then
Cells(I, 2).Font.ColorIndex = 50
Cells(I, 3).Value = "|"
Cells(I, 4).Value = "In DocQuest"
GoTo FIN2
End If
Next J
FIN2:
Next I
fin:
Application.ScreenUpdating = True
End Sub
Merci par avance