Discussion :

[idefix007]

Bonjour à tous,

Je bloque sur mon code


J'ai dû, d'après une fonction filtre de 2 colonnes, rechercher les valeurs dans un tableau avec beaucoup de données tous les articles se terminant par 111-02 et dont la référence 'TOTAUX : ' est reprise dans la colonne B.
J'ai stocké provisoirement le résultat de cette recherche dans un tableau dont vous trouverez une illustration ci-dessous.
Jusque là, ça va.

En dessous de ces valeurs stockées, j'ai un deuxième tableau avec d'autres articles.
Je dois reprendre les montants (de la colonne E à J) de mon tableau "provisoire" et les mettre dans les colonnes qui correspondent aux articles de mon deuxième tableau.
Le critère de correspondance est : les 3 ou 4 premiers chiffres du tableau provisoire = 3 ou 4 premiers chiffres du 2ème tableau + 33/465-02

Je dois pouvoir les mettre sous forme de formule (SumIf ?) afin de pouvoir y additionner d'autres éventuels articles. Ce n'est donc pas juste une copie de la valeur à faire.

Des pistes?


Merci par avance pour votre aide.
PS : J'ai, dans un autre poste, eu le conseil de déclarer toutes mes variables et de bien indenter mon code.J'y travaille ;-)




Et voici un début de code de mon tableau initial:

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
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
 
Sub Filtre2cond_11102_TOT()
 
' RECETTES
Dim VarArt As String
Dim VarServ As String
 
 
 
   Set f = Sheets("Para-RH-2018")
 
   Tbl = f.Range("A3:BO" & f.[A65000].End(xlUp).Row).Value
 
 
   Clé1 = "TOTAUX :": colClé1 = 2 'colonne B
   Clé2 = "111-02": colClé2 = 3 'colonne C
    b = FiltreMultiCol2(Tbl, colClé1, Clé1, Array(2, 3, 62, 63, 64, 65, 66, 67), colClé2, Clé2, 1) ' Array(62,63,...) reprend les colonnes de BJ à BO
 
   If Not IsEmpty(b) Then Sheets("Para-RH-2018").[C2988].Resize(UBound(b), UBound(b, 2)) = b ' à partir de la colonne C3001
 
 
   For i = LBound(b) To UBound(b)
        VarArt = b(i, 2)
        VarServ = Left(VarArt, 3)
        x = InStr(1, b(1, 2), VarServ)
 
        Debug.Print b(i, 2)
        Debug.Print VarServ
 
    Clé3 = VarServ: colClé3 = 2 'colonne B
    c = FiltreMultiCol2(b, colClé3, Clé3, Array(3, 4, 5, 6, 7, 8))
 
    If Not IsEmpty(c) Then Sheets("Para-RH-2018").[C3001].Resize(UBound(c), UBound(c, 2)) = c ' à partir de la colonne C3001
 
 
   Next i
 
 
End Sub
 
 
 
 
 
Function FiltreMultiCol2(Tbl, colClé1, Clé1, ColResult, Optional colClé2, Optional Clé2, Optional ColTri)
 
  Dim b()
 
        ligne = 1
        If IsMissing(colClé2) Then colClé2 = colClé1: Clé2 = Clé1
        For i = LBound(Tbl) To UBound(Tbl)
           ' If Tbl(i, colClé1) = Clé1 And Tbl(i, colClé2) = Clé2 Then n = n + 1
            If InStr(1, Tbl(i, colClé1), Clé1, vbTextCompare) > 0 And InStr(1, Tbl(i, colClé2), Clé2, vbTextCompare) > 0 Then n = n + 1 ' Instr pour dire que Clé1 et Clé2 COMPREND la chaîne de caractère
        Next i
 
        If n > 0 Then
 
          If IsArray(ColResult) Then
            ReDim b(LBound(Tbl) To n, LBound(ColResult) + 1 To UBound(ColResult) - LBound(ColResult) + 1)
          Else
            ReDim b(LBound(Tbl) To n, 1 To 1)
          End If
 
          For i = LBound(Tbl, 1) To UBound(Tbl, 1)
 
             ' If Tbl(i, colClé1) = Clé1 And Tbl(i, colClé2) = Clé2 Then
              If InStr(1, Tbl(i, colClé1), Clé1, vbTextCompare) > 0 And InStr(1, Tbl(i, colClé2), Clé2, vbTextCompare) > 0 Then
                 If IsArray(ColResult) Then
                    For c = LBound(ColResult) To UBound(ColResult)
                        col = ColResult(c)
                        b(ligne, c + 1) = Tbl(i, col)
                    Next c
                 Else
                    b(ligne, ColResult) = Tbl(i, ColResult)
                 End If
                 ligne = ligne + 1
              End If
         Next i
 
         If Not IsMissing(ColTri) Then Call TriCol(b, LBound(b), UBound(b), ColTri)
            FiltreMultiCol2 = b
         End If
 
End Function
 
Sub TriCol(a(), gauc, droi, ColTri)         ' Tri pour la fonction FiltreMultiCol2
 Ref = a((gauc + droi) \ 2, ColTri)
 g = gauc: d = droi
 Do
     Do While a(g, ColTri) < Ref: g = g + 1: Loop
     Do While Ref < a(d, ColTri): d = d - 1: Loop
     If g <= d Then
       For col = LBound(a, 2) To UBound(a, 2)
          temp = a(g, col): a(g, col) = a(d, col): a(d, col) = temp
       Next col
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call TriCol(a, g, droi, ColTri)
 If gauc < d Then Call TriCol(a, gauc, d, ColTri)
End Sub

[mjpmjp]

bonjour,
le problème c'est :
la ligne 1 104/465 et
la ligne 2 10433/465
pourquoi la ligne 2 et pas la 1 ?

ok j'avais pas capté + 33/465-02

Le critère de correspondance est : les 3 ou 4 premiers chiffres du tableau provisoire = 3 ou 4 premiers chiffres du 2ème tableau + 33/465-02

@+JP

[mjpmjp]

bonjour,
construction de la clé

Code :

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

1
2
3
4
5
6
Prefix="33/465-02"
CodLigne="104/111-02"
 
split(CodLigne,"/")(0) --> "104"
 
CleRecherche=split(CodLigne,"/")(0) & Prefix

transfer

Code :

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

1
2
3
SomLigne="76973,41"
 
if cells(ligne,2).value = CleRecherche then cells(ligne,3).value = SomLigne

@+JP

[idefix007]

Bonjour,

Merci tout d'abord de répondre à mon post.

C'est effectivement pas évident à expliquer.

J'ai par exemple un article 104/111-02 dans mon premier tableau (le tableau provisoire qui est en fait un tableau en mémoire).
Les montants de cet article (se retrouvant dans les colonnes E,F,G,H,I,J) doivent être ajoutés l'article 10433/465-02 de mon deuxième tableau (en colonnes C,D,E,F,G,H).
L'article 104/465-02 ne comprend pas cet article 104/111-02.
Seuls les articles se terminant par 33/465-02 ont un lien avec les articles se terminant par /111-02.

Autre exemple:
Article 8443/111-02. Les montants doivent être ajoutés à l'article 844333/465-02.

J'espère être plus claire.

Merci. Je viens de voir votre proposition que je vais tester de ce pas.
Un grand merci.

[idefix007]

Voilà j'ai adapté mon code. La variable CleRecherche fonctionne à merveille. Merci 1000 fois pour cette aide.
J'ai juste encore un petit souci pour le transfère des montants.
Ma boucle while enregistre juste la première donnée trouvée. Elle ne boucle donc pas je pense et je ne parviens pas à voir où est mon erreur. Sans doute un souci algorithmique?

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
Sub Filtre2cond_11102_TOT()
 
Dim VarArt As String ' Variable pour mettre en mémoire l'article
Dim ys As Integer
ys = 3001 ‘Commencer à la ligne 3001 (début du 2ème tableau)
 
 
   Set f = Sheets("Para-RH-2018")
 
   Tbl = f.Range("A3:BO" & f.[A65000].End(xlUp).Row).Value
 
    ' filtres - Appel de la fonction FiltreMultiCol2
 
   Clé1 = "TOTAUX :": colClé1 = 2 'Filtre 1 : colonne B
   Clé2 = "111-02": colClé2 = 3 'Filtre 2 : colonne C
    b = FiltreMultiCol2(Tbl, colClé1, Clé1, Array(2, 3, 62, 63, 64, 65, 66, 67), colClé2, Clé2, 1) ' Array(62,63,...) reprend les colonnes de BJ à BO
 
    'Test : à partir de la colonne C2988
   If Not IsEmpty(b) Then Sheets("Para-RH-2018").[C2988].Resize(UBound(b), UBound(b, 2)) = b ' b = tableau en mémoire sur les articles filtrés ci-dessus
 
   For i = LBound(b) To UBound(b)
        ' Article
        VarArt = b(i, 2) ' tableau(ligne,colonne)
        'Construction de la clé qui permettra de dire que les articles FFF/111-02 sont à ajouter aux articles FFF33/465-02
        Prefix = "33/465-02"
        CleRecherche = Split(VarArt, "/")(0) & Prefix ' split(VarArt,"/")(0) --> reprend les chiffres de l'article avant le / (qu'il y ait 3 chiffres ou 4)
 
        Debug.Print b(i, 2)
        Debug.Print CleRecherche
 
        'transfère du montant de l'article FFF/111-02 vers FFF33/465-02
 
        While f.Cells(ys, 2) <> ""
 
            If f.Cells(ys, 2).Value = CleRecherche Then
            f.Cells(ys, 3).Value = b(i, 3)
            End If
 
        Debug.Print f.Cells(ys, 3)
 
        ys = ys + 1 'Incrémenter pour passer à la ligne suivante
 
        Wend
 
   Next i
 
 
End Sub

[mjpmjp]

bonjour,
controle lbound et ubound ,
je suis pas sur du résultat
For i = LBound(b) To UBound(b) --> For i = LBound(b,1) To UBound(b,1)
@+JP

[idefix007]

Merci pour ta réaction rapide.
J'ai testé de mettre ma boucle while avant ma boucle for et cela fonctionne comme ça :-)

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
32
33
34
35
36
37
38
39
40
 
While f.Cells(ys, 2) <> ""
 
   For i = LBound(b) To UBound(b)
        ' Article
        VarArt = b(i, 2) ' tableau(ligne,colonne)
        'Construction de la clé qui permettra de dire que les articles FFF/111-02 sont à ajouter aux articles FFF33/465-02
        Prefix = "33/465-02"
        CleRecherche = Split(VarArt, "/")(0) & Prefix ' split(VarArt,"/")(0) --> reprend les chiffres de l'article avant le / (qu'il y ait 3 chiffres ou 4)
 
        Debug.Print b(i, 2)
        Debug.Print CleRecherche
 
        'transfer du montant de l'article FFF/111-02 vers FFF33/465-02
 
        'While f.Cells(ys, 2) <> ""
 
            If f.Cells(ys, 2).Value = CleRecherche Then
            f.Cells(ys, 3).Value = b(i, 3)
            f.Cells(ys, 4).Value = b(i, 4)
            f.Cells(ys, 5).Value = b(i, 5)
            f.Cells(ys, 6).Value = b(i, 6)
            f.Cells(ys, 7).Value = b(i, 7)
            f.Cells(ys, 8).Value = b(i, 8)
            End If
 
 
        'ys = ys + 1 'Incrémenter pour passer à la ligne suivante
 
        'Debug.Print f.Cells(ys, 3)
 
        'Wend
 
   Next i
 
           ys = ys + 1 'Incrémenter pour passer à la ligne suivante
 
        Debug.Print f.Cells(ys, 3)
 
        Wend