[ RESOLU ] Tries ,classer.et transferer dans d'autres pages..???

  • Initiateur de la discussion Initiateur de la discussion Guido
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Guido

XLDnaute Accro
Bonjour le Forum

Dans la page Data Données Brute se trouve des données .

La page Data D B est divisée par 4 plages identiques, qui elle-même contiennent 10 plages

Ces données change selon l'évolution des arrivées par un clic de ma part.

Clic que je fait une fois toutes les demi heures..???

Je Vous explique ma demande

1° Triés les 40 plages qui se trouvent dans Data Données Brute

Le tri concerne la colonne " F " du plus petit au plus grand

ceci pour les 40 plages contenant les données en colonne " F " pour faire les classements

2° Apres avoir effectués les tris….

Sélectionnées les 3 premiers N° qui se trouvent dans la colonne " K "

et faire un copier -coller speciale avec transposé dans les


feuilles V 1000 % R1 ,R2 .R3 ,R4 dans le Tableau arrivées Plage C29:E38.

Dans la page Data …Dezire je l'ai fais manuellement..

Merci pour votre future aide.

Guido
 

Pièces jointes

Re Guido 🙂
Salut ChTi160

Le code complété, à tester avec le fichier du post#1
VB:
Option Explicit
Sub ventile()
Dim a, i As Long, j As Long, k As Byte, txt As String
Dim ws As Worksheet, dico As Object
    'creation du dictionnaire parent
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Data Données  Brute")
        For i = 2 To 801 Step 20
            'plage à traiter
            a = .Range("A" & i & ": L" & i + 19).Value
            'clé = nom de la feuille de destination
            txt = "V 1000 %  " & Left(a(2, 12), 2)
            If Not dico.exists(txt) Then
                'creation du dictionnaire enfant
                Set dico(txt) = CreateObject("Scripting.Dictionary")
                dico(txt).CompareMode = 1
            End If
            'clé = n° de la réunion & n° de la course
            If Not dico(txt).exists(a(2, 12)) Then
                'creation du dictionnaire petit enfant
                Set dico(txt)(a(2, 12)) = CreateObject("Scripting.Dictionary")
                dico(txt)(a(2, 12)).CompareMode = 1
            End If
            For k = 1 To UBound(a, 1)
                If Not IsEmpty(a(k, 6)) Then
                    'clé = n° d'ordre d'arrivée converti pour la circonstance
                    a(k, 6) = a(k, 6) & IIf(a(k, 6) = 1, "er", "è")
                    If Not dico(txt)(a(2, 12)).exists(a(k, 6)) Then
                        'on affecte l'element soit le n° du cheval situé en colonne 11
                        dico(txt)(a(2, 12))(a(k, 6)) = a(k, 11)
                    End If
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        If dico.exists(ws.Name) Then
            With ws.Range("b27").CurrentRegion
                With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1)
                    .ClearContents
                End With
                For i = 3 To .Rows.Count
                    If dico(ws.Name).exists(.Cells(i, 1).Value) Then
                        For j = 2 To .Columns.Count
                            If dico(ws.Name)(.Cells(i, 1).Value).exists(.Cells(2, j).Value) Then
                                .Cells(i, j).Value = dico(ws.Name)(.Cells(i, 1).Value)(.Cells(2, j).Value)
                            End If
                        Next
                    End If
                Next
            End With
        End If
    Next
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89
 
Dernière édition:
Bonjour

le Forum,Marcel32

Merci pour le fichier.

Il y a un bug lors du lancement de la macros..?

J'ai remplacer la page Data.. sans tri..

Voici la capture d'écran.

Merci pour votre future aide

Guido
 

Pièces jointes

  • TRANSFERE (1).xls
    TRANSFERE (1).xls
    292.5 KB · Affichages: 27
  • Capture du Bug  40 Tableaux.PNG
    Capture du Bug 40 Tableaux.PNG
    26.8 KB · Affichages: 33
Bonjour Guido
Bonjour le fil ,Le Forum
je vois que tu vas avoir le choix avec toutes ces Solutions, toutes aussi inintéressantes et efficaces les unes que les autres .
bon pour ce qui est des mises en formes .
Tu me mets des exemples , mais ou vas tu chercher ces Numéros en fonction de quoi ?
ex : Feuille R1 tu me mets "Le Trois" si arrivé Premier ou Deuxième ou Troisième
merci par avance
Amicalement
Jean marie
 
Bonjour Guido
Bonjour le fil ,Le Forum
je vois que tu vas avoir le choix avec toutes ces Solutions, toutes aussi inintéressantes et efficaces les unes que les autres .
bon pour ce qui est des mises en formes .
Tu me mets des exemples , mais ou vas tu chercher ces Numéros en fonction de quoi ?
ex : Feuille R1 tu me mets "Le Trois" si arrivé Premier ou Deuxième ou Troisième
merci par avance
Amicalement
Jean marie

Re

Bonjour le Forum, Jean marie

Oui il y a du monde qui ma fait des proposition ,Merci.

J'ai réussi a intégré la MFC,ca c'est OK.

Les cellules de la plage C3 à C 19,sont rempli manuellement par moi...

Voici le fichier presque parfait...lol

Merci

Guido
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour