Extraire une liste de données
Bon, je veux bien jeter un œil, mais si c'est une usine à gaz j'arrête !
Qu'est-ce qu'il a y a de plus qu'avec ce que j'ai proposé ? on pourrait aussi améliorer ...
L'avantage c'est que ça n'affiche qu'une seule fois la même opération et que ça fait la somme pour une même opération.
Par contre je pense que le fichier est trop gros pour être envoyé ici...
Quelqu'un est intéressé?
Voici la fonction que je voudrais mettre dans mon fichier
Function TestBd(Code As String) As String
' recapitulation code
Dim F2 As Worksheet
Set F2 = Worksheets("EC")
TabEC = F2.Range(F2.Cells(4, 1), F2.Cells(F2.Cells(65536, 1).End(xlUp).Row, 22))
For i = LBound(TabEC, 1) To UBound(TabEC, 1)
If Code = TabEC(i, 1) Then
TestBd = Trim(TestBd) & Trim(TabEC(i, 10)) & " = " & Trim(TabEC(i, 17)) & "; "
End If
Next i
'MsgBox Left(TestBd, Len(TestBd) - 2)
' decoupage pour somme.
TabSomme = Split(TestBd, "=")
'MsgBox UBound(TabSomme)
' creation tableau pour somme
Dim TabRes() As Variant
ReDim TabRes(0 To UBound(TabSomme) - 1, 1 To 2)
For j = LBound(TabRes, 1) To UBound(TabRes, 1)
TabRes(j, 1) = Split(Split(TestBd, ";")(j), "=")(0)
TabRes(j, 2) = Split(Split(TestBd, ";")(j), "=")(1)
Next j
j = Empty
' Recherche les doublons
ReDim Preserve TabRes(LBound(TabRes, 1) To UBound(TabRes, 1), LBound(TabRes, 2) To 4)
For j = LBound(TabRes, 1) To UBound(TabRes, 1)
For k = j + 1 To UBound(TabRes, 1)
If TabRes(j, 1) = TabRes(k, 1) Then
TabRes(k, 3) = "D"
End If
Next k
Next j
' somme
For j = LBound(TabRes, 1) To UBound(TabRes, 1)
If TabRes(j, 3) <> "D" Then
For k = j + 1 To UBound(TabRes, 1)
If TabRes(j, 1) = TabRes(k, 1) Then
TabRes(j, 2) = CDbl(TabRes(j, 2)) + CDbl(TabRes(k, 2))
End If
Next k
End If
Next j
' Creation du texte
TestBd = Empty
For j = LBound(TabRes, 1) To UBound(TabRes, 1)
If TabRes(j, 3) <> "D" Then
TestBd = TestBd & Trim(TabRes(j, 1)) & " = " & Trim(TabRes(j, 2)) & "; "
End If
Next j
' MsgBox Left(TestBd, Len(TestBd) - 2)
TestBd = Left(TestBd, Len(TestBd) - 2)
End Function