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

Statistiques des forums

Discussions
312 266
Messages
2 086 652
Membres
103 353
dernier inscrit
jerem'