Discussion :

[sabof38]

Bonjour,

Je suis débutant sur la programmation VBA et j'ai besoin d'un programme ou d'une macro effectuant la fonction comme expliquée ci-dessous:

J'ai quatre colonnes ABCD,

-Sélectionner la première ligne qui sera A2 qui contient une chaîne de caractère du type ("A1234567") par exemple

-La comparer avec toutes les lignes de la colonne C(environ 45000 références) à partir de C2 jusqu'à trouver son équivalent

-Une fois trouvé, copier la valeur située dans la colonne D(exemple si équivalent trouvé en C3, copier la valeur D3)

-Coller celle ci dans la colonne B à côté de la valeur de la colonne A recherchée(exemple si A3 comparée, coller la valeur copiée dans B3)

-Si aucune valeur semblable n'est trouvée dans la colonne C, copier alors la valeur recherchée de la colonne A dans la ligne adjacente de la colonne B(exemple, si A4 est recherché et qu'aucune valeur équivalente n'est trouvée dans la colonne C, copier A4 dans B4)

-Renouveler l'opération pour toutes les valeurs de la colonne A, une par une, le programme se stoppe lorsqu'il n'y a plus de valeur dans la colonne A

-Un bouton devra lancer le programme

Merci beaucoup d'avance pour votre aide

[SfJ5Rpw8]

Bonjour,

Et tu en est ou de ton code ? tu bloque ou ? ..

[Thautheme]

Bonjour Sabof, Bbil, bonjour le forum,

Le code commenté ci-dessous est appliqué à un CommandButton issue des contrôles ActiveX :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton1_Click()
Dim O As Object 'déclare la variable O (Onglet)
Dim DLA As Long 'déclare la variable DLA (Dernière Ligne colonne A)
Dim TCA As Variant 'déclare la variable TCA (Tableau de Cellules colonne A)
Dim DLC As Long 'déclare la variable DLC (Dernière Ligne colonne C)
Dim TCC As Variant 'déclare la variable TCC (Tableau de Cellules colonne C)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément)
 
deb = Timer 'debut du chronomètre
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
ActiveCell.Select 'enlève le focus au bouton
Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter éventuellement)
DLA = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DLA de la colonne 1 (=A) de l'onglet O
TCA = O.Range("A1:A" & DLA) 'définit le tableau de cellules TCA
DLC = O.Cells(Application.Rows.Count, 3).End(xlUp).Row 'définit la dernière ligne éditée DLC de la colonne 3 (=C) de l'onglet O
TCC = O.Range("C1:C" & DLC) 'définit le tableau de cellules TCC
For I = 2 To UBound(TCA, 1) 'boucle 1 : sur toutes les lignes du tableau TCA (en partant de la seconde)
    For J = 2 To UBound(TCC, 1) 'boucle 2 : sur toutes les lignes du tableau TCC (en partant de la seconde)
        If TCA(I, 1) = TCC(J, 1) Then 'condition : si les deux valeur sont identiques
            O.Cells(I, 2).Value = O.Cells(J, 4) 'récupère dans la colonne B de la ligne de TCA, la valeur de la cellule en colonne D de la ligne de TCC
            GoTo suite 'va à l'étiquette "suite"
        End If 'fin de la condition
    Next J 'prochaine ligne de la boucle 2
    O.Cells(I, 2).Value = O.Cells(I, 1).Value 'récupère dans la colonne B de la ligne de TCA, la valeur de la cellule en colonne A de la ligne de TCA
suite: 'étiquette
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
fin = Timer - deb 'fin du chrornomètre
MsgBox "Données traitées en " & fin & " secondes !" 'message
End Sub

[sabof38]

Bonsoir,

Je viens de tester ton code et il marche très bien, du coup j'avais fait d'une façon différente mais les deux solutions sont bonnes à prendre, ma solution est basée sur une formule,

Dans B2 la formule à étirer est,

=SI(ESTNA(INDIRECT(ADRESSE(E2;4)));A2;(INDIRECT(ADRESSE(E2;4))))

Et dans E2,

=EQUIV(A2;$C$1:$C$45000;0)

Si cela peu servir,

A bientôt et encore merci