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 |
Partager