1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
| Option Explicit
Sub recherche_Contrat()
'Intialisation des variables
Dim tototi As String
Dim ORDER_ID As Double, ORIGIN_AMOUNT As Double
Dim i As Double
Dim rng_rejet As Range
Dim rng_sibo As Range
Dim NB_LIGNE_REJET As Double, NB_LIGNE_SIBO As Double
'A décommenté pour accélérer la macro
'Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False
'Set à NB_LIGNE_REJET le nombre de ligne qu'on trouve dans la colonne C de la feuille REJET
NB_LIGNE_REJET = Worksheets("REJET").Columns(3).Find("*", , , , , xlPrevious).Row
'Avec la feuille REJET...
With Worksheets("REJET")
'on instancie rng_rejet sur la cellule C1
Set rng_rejet = .Range("C1")
'et on boucle de i = 1 à NB_LIGNE_REJET
For i = 1 To NB_LIGNE_REJET
'Si longueur de la chaine dans la cellule de rng_rejet avec un décalage de i ligne(s) est suppérieure ou égale à 2...
If Len(rng_rejet.Offset(i, 0)) >= 2 Then
'... alors on set la variable tototi sur les deux premiers caractères de gauche
tototi = Left(rng_rejet.Offset(i, 0), 2)
'Si ces deux caractères sont compris dans la chaine "20,21,25,28,40,41,45,70,71"...
If InStr("20,21,25,28,40,41,45,70,71", tototi) Then
'... alors on set l'ID complet de rng_rejet avec un décalage de i ligne(s) dans ORDER_ID (/!\ ORDER_ID est un chiffre numérique)
ORDER_ID = rng_rejet.Offset(i, 0)
'et on set le montant qui se trouve avec un décalage de deux colonnes dans ORIGIN_AMOUNT.
ORIGIN_AMOUNT = rng_rejet.Offset(i, 2)
'On appelle la fonction personalisée "recherche" (définie plus bas) en passant les variables ORDER_ID et ORIGIN_AMOUNT.
'Cette fonction retourne une range qu'on stocke dans rng_sibo.
Set rng_sibo = recherche(ORDER_ID, ORIGIN_AMOUNT)
'Si le retour de la fonction n'est pas "Nothing", cela signifie qu'on a trouvé un montant différent pour un ORDER_ID identique.
If Not rng_sibo Is Nothing Then
'On vérifie si on a sur la colonne de droite de la cellule remontée par "recherche" le terme "CHRONOPOST".
If InStr(rng_sibo.Offset(0, 1), "CHRONOPOST") Then
'Si oui, on place dans la cellule rng_rejet décalée de i ligne(s) et 5 colonnes la montant dans rng_sibo - 10.
rng_rejet.Offset(i, 5) = rng_sibo.Value - 10
'Vérification avec "COLISSIMO"
ElseIf InStr(rng_sibo.Offset(0, 1), "COLISSIMO") Then
'Si oui, on place dans la cellule rng_rejet décalée de i ligne(s) et 5 colonnes la montant dans rng_sibo - 5.
rng_rejet.Offset(i, 5) = rng_sibo.Value - 5
End If
End If
End If
End If
Next i
End With
'A décommenté pour accélérer la macro
'Application.ScreenUpdating = True
'Application.Calculation = xlCalculationAutomatic
MsgBox "Mise à jour terminée!", vbInformation
End Sub
'La fonction personnalisée "recherche"
Public Function recherche(ORDER_ID As Double, ORIGIN_AMOUNT As Double)
'Initialisations des variables internes à la fonction
Dim rng As Range
Dim last As Range
Dim rech As Range
'Avec la feuille "SIBO"
With Worksheets("SIBO")
'On set last sur la dernière cellule non vide de la colonne 2.
Set last = .Columns(2).Find("*", , , , , xlPrevious)
'On set rng sur la première cellule de la colonne 2 (B1).
Set rng = .Range("B1")
'On boucle à l'infini. Mais on sort de la boucle dès qu'une des deux conditions est atteinte :
'1) On trouve un ID commun à ORDER_ID et un montant différent à ORIGIN_AMOUNT
'2) On ne trouve plus d'ID commun à ORDER_ID
Do While True
'On set rech sur la cellule qui contient ORDER_ID sur la plage de valeur [rng ; last]
Set rech = .Range(rng, last).Find(ORDER_ID, LookIn:=xlValues, LookAt:=xlWhole)
'Si on ne trouve pas rien... (si on trouve quelque chose ;) )
If Not rech Is Nothing Then
'On vérifie que le montant (décalé d'une colonne - en C) est différent de ORIGIN_AMOUNT
If rech.Offset(0, 1) <> ORIGIN_AMOUNT Then
'Si oui, on renvoi la celulle qui contient ce montant différent et on sort de la fonction
Set recherche = rech.Offset(0, 1)
Exit Function
'Si le montant est identique on continue de vérifier s'il n'existe pas un autre ID commun avec un montant différent dans le reste de la colonne B.
Else
Set rng = rng.Offset(1, 0)
End If
'Si on ne trouve rien...
Else
'On renvoie "Nothing" pour dire qu'on a rien trouvé et on sort de la fonction.
Set recherche = Nothing
Exit Function
End If
Loop
End With
End Function |
Recherche le nombre de lignes d'une feuille Excel
Répondre avec citation
Envoyé par laminosd
Partager