[XL-2003] Difficultés attribution besoins (Concatenation et recherchev par macro)

2 pièce(s) jointe(s)

Difficultés attribution besoins (Concatenation et recherchev par macro)

Bonjour à tous,

Je suis bloqué pour mettre en place une macro qui réalise une sorte de recherchev.

Voici un exemple simplifié de mon fichier :
Pièce jointe 150515

J'ai donc deux onglets :
- Onglet "BESOINS" : On retrouve les besoins à réaliser pour la semaine. Ces besoins sont renseignés à la main par une personne. A chaque besoin correspond une heure de sortie.
- Onglet "HISTO" : C'est la que la macro doit entrer en jeu. Dans l'onglet "BESOINS", il faut qu'elle concatène les besoins et les heures avec les types de véhicule identique (voir pièce jointe). Et ensuite qu'elle affiche la concaténation dans l'onglet "HISTO" devant le bon type de véhicule.

Je vous remets le code que j'utilise mais vous pouvez le retrouver dans la pièce jointe.

Code:

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
'============= Concatenation des besoins ========================'
'================================================================'
Sub Concatenation_Besoins()
Dim Tab_Already() As Integer, Tab_Resultats()
Dim Tab_ColonneBD
Dim TheCell As Range
Dim IRowP As Long, IRowS As Long, IRowM As Long 'P=Primaire, S=Secondaire, M=Maxi
Dim OneInt
Dim StrConcat As String
Dim i As Integer
Dim j, v, total As Integer
 
'On initialise les tableaux
ReDim Tab_Already(0)
ReDim Tab_Resultats(1, 0)
Tab_ColonneBD = Range("A2", Cells(Rows.Count, "D").End(xlUp)).Value
IRowM = Cells(Rows.Count, "B").End(xlUp).Row - 2
i = 1
j = 1
 
For IRowP = 1 To IRowM
    'On verifie que le numero n'a pas deja ete traité
    For Each OneInt In Tab_Already
        If OneInt = CInt(Tab_ColonneBD(IRowP, 2)) Then
            GoTo suite
        End If
    Next
 
    If IRowP <> i Then
        Sheets("BESOINS").Cells(j, 6).Value = Cells(i + 1, rColAct)
        Sheets("BESOINS").Cells(j, 7) = StrConcat
        j = j + 1
    End If
    'On rajoute le numero dans la liste des num deja traité (la colonne A ne doit pas contenir de 0
    If Tab_Already(UBound(Tab_Already)) <> 0 Then
        ReDim Preserve Tab_Already(UBound(Tab_Already) + 1)
        Tab_Already(UBound(Tab_Already)) = CInt(Tab_ColonneBD(IRowP, 2))
    End If
    'On initialise le concatenation avec le 1er texte
        StrConcat = CStr(Tab_ColonneBD(IRowP, 3)) & " -> " & CStr(Tab_ColonneBD(IRowP, 4))
'On recherche les autres cellules contenant cette valeur à partir de IRowP+1
    For IRowS = IRowP + 1 To IRowM
    On Error Resume Next
        If Tab_ColonneBD(IRowP, 2) = Tab_ColonneBD(IRowS, 2) Then
            StrConcat = StrConcat & " / " & CStr(Tab_ColonneBD(IRowS, 3)) & " -> " & CStr(Tab_ColonneBD(IRowS, 4))
            Else: i = IRowP
        End If
    Next
 
suite:
Next
 
Sheets("HISTO").Select
i = Cells(Row.Count, 2).End(xlUp)
Sheets("BESOINS").Select
j = Cells(Row.Count, 1).End(xlUp)
'Dans mon fichier initial j'utilise des variables comme rCelDeb. Et le VLookup ne fonctionne pas....
Cells(2, 2).FormulaR1C1 = "=VLookup(B" & rCelDeb & " :B " & j & ", Paramètre_Besoins!B1:C " & i & ", 2, 0)" 
Selection.AutoFill Destination:=Range(Cells(2, 2), Cells(j, 2)), Type:=xlFillDefault
 
End Sub

Alors il y a deux problèmes :
- La premiere partie du code pour la concaténation ne fonctionne pas entièrement (voici pièce jointe, feuille "BESOINS")
- Je n'arrive pas à insérer la recherchev. Peut etre qu'il y a une autre solution que la recherchev.

Si vous avez une idée pour faire avancer mon probleme, je suis preneur !

Merci à tous ! :)

Bonjour,

Je te conseille d'enlever ton on error resume next, et d'utiliser option explicit dans ton module.

Ca devrait te permettre d'y voir plus clair,

Poulpe

Merci pour ton conseil Mr Poulpe ! :)

C'est bon j'ai résolu mes deux problèmes.
Si ca peut servir, voici le code que j'ai utilisé :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Concat()
Dim DerLigne, i As Integer
Dim Activ, Cel As Range
DerLigne = Cells(Rows.Count, rColLoc).End(xlUp).Row
 
For i = rCelDeb To DerLigne
Set Activ = Sheets("HISTO").Cells(i, rColAct)
    For Each Cel In Sheets("Besoins_STF").Range("L1:L25")
        If Activ = Cel.Value Then
            Sheets("HISTO").Cells(i, rColBes).Value = Sheets("Besoins").Cells(Cel.Row, 13).Value
        End If
     Next Cel
Next i
End Sub

Pour le problème de la concaténation j'ai rajouté une condition.

Bonne journée à tous !