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