ranger des données en les comptant par rapport à deux colonnes !

Makina

XLDnaute Junior
Bonjours a tous,

Je viens de passer la matiné à essayer de faire ce bout de programme et après des if impriqués des until, while et autres, je n y arrive toujours pas ...
Une image en pj illustrera peut etre mieux ma situation.
J ai créé une ligne pour ranger un tableau, maintant j aimerais ranger dans un autre tableau (autre feuille) une seule fois un des numéros (identiques) de ma colonne F en A10 de ma feuille 1, puis sur la meme ligne (10) ranger en C10 une des lettre (identiques) de ma colonne G avec le nombre de fois qu elle est répétée à la suite en D10 la lettre suivante en E10 avec sont nombre de repetition en F10 ...

L'image sera plus claire ^^

Merci d avance.
 

Pièces jointes

  • Sans titre.jpg
    Sans titre.jpg
    64.3 KB · Affichages: 85
  • Sans titre.jpg
    Sans titre.jpg
    64.3 KB · Affichages: 96
  • Sans titre.jpg
    Sans titre.jpg
    64.3 KB · Affichages: 96

Makina

XLDnaute Junior
Re : ranger des données en les comptant par rapport à deux colonnes !

Re,

Voici en PJ les deux tableau et le sub que j ai commencer (il est faux et a beaucoup de lignes en trop pour tester)

Merci de votre aide

Cordialement,
Makina
 

Pièces jointes

  • Cartonette_test.xlsm
    25.5 KB · Affichages: 50

Makina

XLDnaute Junior
Re : ranger des données en les comptant par rapport à deux colonnes !

Bonjour,

J ai toujours mon problème, et j ai presque trouvé la solution :
Code:
k = 10
i = 3
m = 4
n = 1
'vérifie tous les codes barres
For m = 4 To p
n = 1
If Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 1, 7) <> Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 2, 7) Then
m = m + 1

End If

While Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 1, 6) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 2, 6) And m < p And Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 1, 7) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 2, 7)
    n = n + 1
Wend
Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(k, i + 1) = n
If Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 2, 7) <> Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 3, 7) Then
m = m - 1
End If
Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(k, i) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 7)
If Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + 1, 6) <> Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 6) Then
k = k + 1
i = 3
GoTo 20
End If
Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(k, 1) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 6)
Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(k, 2) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 2)
If Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 6) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m - 1, 6) And m < p Then
i = i + 2
20
End If
Next
   

End Sub

Seulement il ne fonctionne correctement QUE si j ai pas plus de 2x la meme lettre dans ma colonne 7. Il me faudrait un compteur de plus pour savoir le nombre de ligne a sauter mais je ne vois plus ou le mettre ! HELP PLEASE

Merci
 

Makina

XLDnaute Junior
Re : ranger des données en les comptant par rapport à deux colonnes !

Bon après bidouille sur bidouille, j arrive au résultat voulu d une facon pas propre du tout !

Code:
Sub trier()
Dim n As Integer
Dim l As Integer
Dim i As Integer


p = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(2, 1).Value
Worksheets("Code_barre").Select
Range(Cells(3, 1), Cells(p, 7)).Sort Key1:=Cells(3, 6), Key2:=Cells(3, 7)
Worksheets("feuil1").Select

k = 10
i = 3
m = 4
n = 1
'vérifie tous les codes barres
For m = 4 To p
n = 1
If Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 1, 7) <> Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 2, 7) Then
m = m + 1

End If

While Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 1, 6) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 2, 6) And m < p And Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 1, 7) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 2, 7)
    n = n + 1
Wend
Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(k, i + 1) = n
If Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 2, 7) <> Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + n - 3, 7) Then
m = m - 1
End If
Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(k, i) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 7)
If Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m + 1, 6) <> Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 6) Then
k = k + 1
i = 3
GoTo 20
End If
Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(k, 1) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 6)
Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(k, 2) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 2)
If Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m, 6) = Workbooks("Cartonette1.xlsm").Sheets("Code_barre").Cells(m - 1, 6) And m < p Then
i = i + 2
20
End If
Next

m = 10
i = 3
k = i
C = i
n = 1

For m = 10 To 17
For C = 3 To 19 Step 2
n = 1
l = C
    While Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(m, C) = Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(m, C + 2)
    C = C + 2
    n = n + 1
    If C >= 21 Then
    GoTo 30
    End If
    Wend
30
If n >= 2 Then
    Do Until C >= 21
        Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(m, l + 2) = Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(m, C + 2)
        Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(m, l + 3) = Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(m, C + 3)
        C = C + 1
        l = l + 1
    Loop
End If
Next C
Next m
End Sub

Le premiere partie ne répond pas a mes attentes du coup la seconde partie du sub règle le problème en décallant tout ... J'aime pas le bidouillage alors si quelqu un peut l'améliorer ...

Merci
 

Discussions similaires