Tri des S et C

Bonjour,

pas sûr d'avoir bien compris ce qu'il fallait faire avec les numéros. je mets un numéro là où je trouve un "C" ou un "S" en colonne F.

Private Sub CommandButton1_Click()
    With Worksheets("feuil1")
        dl = .Range("D" & Rows.Count).End(xlUp).Row
        dn = .Range("M" & Rows.Count).End(xlUp).Row
        pm = 18
        For i = 3 To dl
            If .Cells(i, 4) <> "" Then
                If .Cells(i, 6) <> "" Then
                    pm = pm + 1: If pm > dn Then MsgBox "plus de numéro disponible"
                    .Cells(i, "G") = .Cells(pm, "M")
                    n = n + 10
                    c = .Cells(i, 6)
                    If c = "S" Then c = "A"
                End If
                .Cells(i, 1) = c & Format(n, "000000")
            End If
        Next i
        .Range("A2:K" & dl).Sort Key1:=.Range("A2:A" & dl), Order1:=xlAscending, Header:=xlYes
        .Columns(1).Clear
    End With
End Sub

oui nickel

sauf que je me suis trompé de colonne et ligne

je remet le fichier pour que tu puisse voir les emplacement exact des n° 4xx

par contre je me suis tromper, peux t’ont garder les C en 1er comme avant les S en second et les vides en dernier

la macro attribut les n° 4xx en ordre croissant au C en priorité et au S en second

merci beaucoup pour ton aide

eric

Bonsoir,

code adapté

Private Sub CommandButton1_Click()
    With Worksheets("feuil1")
        dl = .Range("D" & Rows.Count).End(xlUp).Row
        For i = 6 To dl
            If .Cells(i, 4) <> "" Then
                If .Cells(i, 6) <> "" Then
                    n = n + 1
                    c = .Cells(i, 6)
                ElseIf .Cells(i, 3) <> "" And .Cells(i, 4) <> "" Then
                    n = n + 1
                    c = "V"
                End If
                .Cells(i, 1) = c & Format(n, "000000")
            End If
        Next i
        .Range("A5:K" & dl).Sort Key1:=.Range("A5:A" & dl), Order1:=xlAscending, Header:=xlYes
        .Columns(1).Clear
        pm = 34
        For i = 6 To dl
            If .Cells(i, 4) <> "" Then
                If .Cells(i, 6) <> "" Or (.Cells(i, 3) <> "" And .Cells(i, 4) <> "") Then
                    pm = pm + 1
                    .Cells(i, 7) = .Cells(pm, "N")
                End If
            End If
        Next i
    End With
End Sub

tout a une fin snif

merci h2so4 pour ton travail je vais utilisé cette macro qui me convient.

merci pour ton aide et merci au forum

bonne soirée

bon courage.

bonjour h2so4

le fichier marche très bien mais j'ai une petite erreur.

quand je clic sur le bouton,les numéros 4xx s'affectent bien devant les C et S mais si j' moins de C et S que de 4xx, les numéro continue de s’affecter devant rien.

est il possible de les affecter en fonction du nombre de C et S ?

si je m'explique mal n’hésite pas.

merci

bonjour,

quand j'applique la macro sur le fichier que tu as fourni, je ne remarque pas ce problème. donc merci de m'éclairer.

je te repost le fichier avec l'exemple

il m'arrive d'avoir du teste en dessous des S et C, voila ce qui ce passe

j'ai adapté la macro pour qu'elle n'attribue un numéro que lorsque la ligne contient un S ou un C. La version précédente attribuait également un numéro aux lignes sans C et sans S, mais contenant une valeur en colonne 3 et 4.

Private Sub CommandButton1_Click()
    With Worksheets("feuil1")
        dl = .Range("D" & Rows.Count).End(xlUp).Row
        For i = 6 To dl
            If .Cells(i, 4) <> "" Then
                If .Cells(i, 6) <> "" Then
                    n = n + 1
                    c = .Cells(i, 6)
                ElseIf .Cells(i, 3) <> "" And .Cells(i, 4) <> "" Then
                    n = n + 1
                    c = "V"
                End If
                .Cells(i, 1) = c & Format(n, "000000")
            End If
        Next i
        .Range("A5:K" & dl).Sort Key1:=.Range("A5:A" & dl), Order1:=xlAscending, Header:=xlYes
        .Columns(1).Clear
        pm = 34
        For i = 6 To dl
            If .Cells(i, 4) <> "" Then
                If .Cells(i, 6) <> ""  Then
                    pm = pm + 1
                    .Cells(i, 7) = .Cells(pm, "N")
                End If
            End If
        Next i
    End With
End Sub

parfait, je te remercie beaucoup h2so4

a bientôt

bonne journée et bonne fêtes de fin d'année.

bonjour

il me reste une macro pour finaliser la config.

message a h2so4 que je sollicite si possible pour la fin de mon projet.

je poste mon fichier avec ce message.la feuille 1 est parfaite rien a toucher.

le but: pouvoir faire un 2iem trie sur la feuille 2 avec les informations de la feuille 1

j'ai ajouter une colonne (E) sur la feuille 1 et en fonction des informations inscrite dans cette colonne,le 2iem trie ce fait dans la feuille 2,

j'ai mis des infos sur la feuille 2 pour mieux comprendre, pas évident a expliqué!

je veux pouvoir récupérer les info de la feuille 1 et les transmettre dans la feuille 2 au endroit prévu a cet effet.

si vous avez besoin de plus d'info, je ne suis pas pressé, je vous répondrais.

en tous cas merci par avance

désolé mais j'ai rien compris

j’essaie d'expliquer étape par étape.

sur la feuille 2 j'ai créer 8 blocs avec 2 nom de personne pour chaque bloc.

la macro de la feuille a permet de faire un 1er tri entre les S et les C.

je veux créer une deuxième macro sur la feuille n°2.

exemple: pour les C de la feuille 1.

une fois le 1er tri effectuer sur la feuille 1 je marque en E6 "T1" et si je marque la même chose sur la feuille 2 en K2, donc T1.

quand je lance la 2iem macro les cellules D6 te D7 de la feuille 1 doivent être copié en H4 et G5 de la feuille 2.

sur la feuille 2,on s’intéresse aux cellules E2/K2/E23/K23/E44/K44/E65/K65 qui correspondent chacun a un ensemble.

est ce que je suis claire.

j'ai du mal a expliqué!

désolé, mais j'ai toujours pas compris

bonjour h2so4

je reposte un fichier différent plus simple pour l'explication

je voudrais une macro sur la feuille 2

j'ai mis des annotations sur la feuille 2

cordialement

fichier corrompu apparemment.

s'ouvre bien chez moi je le reposte

Bonjour,

sur base de ce que j'ai compris et sur base de la mise en page de ta feuille( une position qui change tout est à revoir) , à tester

ps la mise en page des 2 derniers blocs n'est pas la même que pour les 6 premiers (cela va donner des problèmes...)

Sub test()
    Set ws1 = Worksheets("feuil1")
    dl = ws1.Range("D" & Rows.Count).End(xlUp).Row
    Set ws2 = Worksheets("feuil2")
    For i = 1 To 4
        For j = 1 To 2
            With ws2.Cells((i - 1) * 21 + 2, (j - 1) * 6 + 1)
                lc = 0: ls = 0
                k = 6
                While k <= dl
                    If ws1.Cells(k, "E") = .Range("E1") Then
                        If UCase(ws1.Cells(k, "F")) = "C" Then
                            lc = lc + 1
                            '.Cells(lctox(lc), lctoy(lc)) = ws1.Cells(k, 3)
                            .Cells(lctox(lc), lctoy(lc) + 1) = ws1.Cells(k, 4)
                            l = 0: c = 0
                            k = k + 1
                            While ws1.Cells(k, "F") = "" And k <= dl
                                l = l + 1: If l > 5 Then l = 1: c = c + 1: If c > 1 Then Stop
                                .Cells(lctox(lc) + l, lctoy(lc) + c) = ws1.Cells(k, 4)
                                k = k + 1
                            Wend
                            k = k - 1
                        ElseIf UCase(ws1.Cells(k, "F")) = "S" Then
                            ls = ls + 1
                            .Cells(ls + 2, 5) = ws1.Cells(k, 4)
                        End If
                    End If
                    k = k + 1
                Wend
            End With
        Next j
    Next i
End Sub
Function lctox(lc)
lctox = Int((lc - 1) / 2) * 6 + 3
End Function
Function lctoy(lc)
lctoy = ((lc - 1) Mod 2) * 2 + 1
End Function

ok je modifie pour avoir 8 bloc identique

si par la suite je rajoute dans les bloc une série de mini bloc en plus a la suite pour agrandir est ce que cela va fonctionner?

non, il faudra adapter le code.