VBA trie dans tableau dans un autre tableau

Résolu/Fermé
dy - 12 déc. 2008 à 10:44
 dy - 15 déc. 2008 à 15:46
bonjours à tous ! :hello: :hello:

je viens à vous car j'ais un petit problème algorithmique!

voilà je redonne des pages excel à l'aide tableau
contenant les noms de pages que je remplis précédement dans mon code ! les noms sont du style un numéros à 8 chiffres puis une date entre parenthése ! ex : 47081266(06-10-08)
49458454(02-04-08)
donc ca donne par exemple
nompage1 = tableau(1)
nompage2 = tableau(2) ect ....

je voudrais trié se tableau dans un autre tableau à 2 colonnes par date !
avec dans la deuxiéme colonne le "numéros" de là page.


exemple tableau2 donnerais

1er col.........2eme col
02-04-08 2
06-10-08 1
..ect
1 et 2 étant le numeros de page c'est à dire dans quelle position elle se trouve dans mon classeur


j'éspére avoir était clair !
merci

10 réponses

lupin here ? xD
0
Utilisateur anonyme
12 déc. 2008 à 16:10
Bonjour,

Yes i am ...

je n'ai pas beaucoup de temps ...

Trier Tab1 dans Tab2

1) Affecter Tab1 à Tab2
2) Trier Tab2

Je vais tenter de faire une petite demo ...

Je reviens ...

Lupin
0
enfaite je viens de me relire c'est le numéro de page que je voudrais gardé en mémoire qui me pause probleme!

je pense qui serrais plus préferable de partir avec un tableau
et que je face un truc du style


Option Explicit

Type Tableau
date As Integer
numpage As Integer
End Type
dim tab1 as tableau
ReDim tab1(nbpage)

i = 1
for eatch sheet in worsheets
tab1(i).date = left(sheet.name , 8)
tab(i).numpage =' commande que je vais chercher sur le net pour connaitre la position de la feuille dans le workbook
next sheet

et ensuite trier tab1 par date
0
Utilisateur anonyme
12 déc. 2008 à 17:47
re:

voici un premier jet non-testé.

Option Explicit
'

Sub TrierTableau()

    Dim Tab1() As String, Tab2() As String, Valeur As String
    Dim Boucle1 As Long, Boucle2 As Long
    '
    
    Boucle1 = 5: Boucle2 = 5
    
    ' Ici je dimensionne les tableaux selon
    ' des variables au cas où l'on ne connaitrait
    ' pas d'avance le nombre d'itération dans le tableau
    ReDim Preserve Tab1(Boucle1)
    ' Ici le Tab2 doit avoir 2 collonnes
    ReDim Preserve Tab2(Boucle2, 2)
    
    ' Initialisation du Tab1
    Tab1(0) = "47081266(06-10-08)"
    Tab1(1) = "49458454(02-04-08)"
    Tab1(2) = "48357392(05-07-08)"
    Tab1(3) = "43143257(09-12-08)"
    Tab1(4) = "44561365(10-11-08)"
    
    ' Transfert Tab1 dans Tab2
    For Boucle1 = 0 To 4
        Tab2(Boucle1, 0) = Mid(Tab1(Boucle1), 10, 8): Tab2(Boucle1, 1) = Boucle1
    Next Boucle1
    
    ' Tri de Tab2
    For Boucle1 = 0 To 4
        For Boucle2 = 1 To 4
            If (Tab2(Boucle2, 0) < Tab2(Boucle1, 0)) Then
                Valeur = Tab2(Boucle1, 0)
                Tab2(Boucle1, 0) = Tab2(Boucle2, 0)
                Tab2(Boucle2, 0) = Valeur
                Valeur = Tab2(Boucle1, 1)
                Tab2(Boucle1, 1) = Tab2(Boucle2, 1)
                Tab2(Boucle2, 1) = Valeur
            End If
        Next Boucle2
    Next Boucle1
    
    
End Sub
'

Lupin
0
Utilisateur anonyme
12 déc. 2008 à 20:10
re:

voilà, j'ai retravailler le code ...

n.b. Mon systême a comme paramètres régionaux le format de date utilisé dans mon milieu,
soit : [ AAAA-MM-JJ ]

pour toi, tu défini les dates comme étant [ JJ-MM-AA ], alors il faudra adapter le code de
formatage de la date pour ton environnement.

Option Explicit
'

Sub TrierTableau()

    Dim Tab1() As String, Tab2() As Variant, Valeur As String
    Dim Boucle1 As Long, Boucle2 As Long
    '
    
    Boucle1 = 5: Boucle2 = 5
    
    ' Ici je dimensionne les tableaux selon
    ' des variables au cas où l'on ne connaitrait
    ' pas d'avance le nombre d'itération dans le tableau
    ReDim Preserve Tab1(Boucle1)
    ' Ici le Tab2 doit avoir 2 colonnes
    ReDim Preserve Tab2(Boucle2, 2)
    
    ' Initialisation du Tab1
    Tab1(0) = "47081266(06-10-08)"
    Tab1(1) = "49458454(02-04-08)"
    Tab1(2) = "48357392(05-07-08)"
    Tab1(3) = "43143257(09-12-08)"
    Tab1(4) = "44561365(10-11-08)"
    
    ' Transfert Tab1 dans Tab2 et formatage de la date
    For Boucle1 = 0 To 4
        Valeur = Mid(Tab1(Boucle1), 10, 8)
        Valeur = Format(Valeur, "dd-mm-yy")
        Valeur = Format(Valeur, "yyyy-mm-dd")
        Tab2(Boucle1, 0) = Valeur
        Tab2(Boucle1, 1) = Boucle1
    Next Boucle1
    
    MsgBox Date
    
    Valeur = ""
    For Boucle1 = 0 To 4
        Valeur = Valeur & Tab2(Boucle1, 0) & " - " & Tab2(Boucle1, 1) & vbLf
    Next Boucle1
    MsgBox Valeur
    
    
    ' Tri de Tab2
    For Boucle1 = 0 To 4
        For Boucle2 = (Boucle1 + 1) To 4
            If (Tab2(Boucle2, 0) < Tab2(Boucle2 - 1, 0)) Then
                Valeur = Tab2(Boucle2 - 1, 0)
                Tab2(Boucle2 - 1, 0) = Tab2(Boucle2, 0)
                Tab2(Boucle2, 0) = Valeur
                Valeur = Tab2(Boucle2 - 1, 1)
                Tab2(Boucle2 - 1, 1) = Tab2(Boucle2, 1)
                Tab2(Boucle2, 1) = Valeur
            End If
        Next Boucle2
    Next Boucle1
    
    Valeur = ""
    For Boucle1 = 0 To 4
        Valeur = Valeur & Tab2(Boucle1, 0) & " - " & Tab2(Boucle1, 1) & vbLf
    Next Boucle1
    MsgBox Valeur
    
End Sub
'

Lupin
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Utilisateur anonyme
13 déc. 2008 à 20:26
suite :

Quelques explications :

Entre le premier jet et le second, j'ai bien sur testé sur,
mon systême, pour validé le tri par date. Or le premier
[ MsgBox ] fournit le format d'heure du systême en cours,
et j'ai modifié le type de Tab2 de [ String ] à [ Variant ].
Ainsi le type subit une promotion/démotion de type au besoin
et lorsqu'il rencontre le bon format de la date
il devient de type [ Date ] de façon dynamique.

Toutefois l'utilisation du type Variant n'est pas
recommandé, on ne l'utilise que dans des cas comme
ici. D'après les premières lignes de code que tu as lancé,
je ne crois pas qu'il soit utile d'avoir 2 tableaux ???

Alors voici une autre version, modifié selon tes besoins,
du moins je crois ...

Option Explicit
'

Sub TrierTableau2()

    Dim Tableau() As Variant, Valeur As String
    Dim Limite As Long, Boucle As Long, I As Long, J As Long
    '
    
    ' Ici je dimensionne le tableau selon
    ' le nombre de feuilles du classeur
    ' l'indice 0 ne sera pas utilisé. [ 1 .. x ]
    Limite = ActiveWorkbook.Worksheets.Count
    ' La seconde dimension [ 0..1 ] ( ", 2" )
    ' founira l'index de la feuille -> [ Sheets(Tableau(x,1)).Select ]
    ReDim Tableau((Limite + 1), 2)
    ' Pour cibler la troisième feuille du tableau
    ' [ Sheets(Tableau(3,1)).Select ]
    
    ' Capture des noms de feuilles dans Tableau et formatage de la date
    For Boucle = 1 To Limite
        Valeur = Mid(Sheets(Boucle).Name, 10, 8)
        Valeur = Format(Valeur, "dd-mm-yy")
        Valeur = Format(Valeur, "yyyy-mm-dd")
        Tableau(Boucle, 0) = Valeur: Tableau(Boucle, 1) = Boucle
    Next Boucle
    
    MsgBox Date
    
    Valeur = ""
    For Boucle = 1 To Limite
        Valeur = Valeur & Tableau(Boucle, 0) & " - " & Tableau(Boucle, 1) & vbLf
    Next Boucle
    MsgBox Valeur
    
    ' Tri de Tableau
    For I = 1 To Limite
        For J = (I + 1) To Limite
            If (Tableau(J, 0) < Tableau(J - 1, 0)) Then
                Valeur = Tableau(J - 1, 0)
                Tableau(J - 1, 0) = Tableau(J, 0)
                Tableau(J, 0) = Valeur
                Valeur = Tableau(J - 1, 1)
                Tableau(J - 1, 1) = Tableau(J, 1)
                Tableau(J, 1) = Valeur
            End If
        Next J
    Next I
    
    Valeur = ""
    For Boucle = 1 To Limite
        Valeur = Valeur & Tableau(Boucle, 0) & " - " & Tableau(Boucle, 1) & vbLf
    Next Boucle
    MsgBox Valeur
    
    Sheets(Tableau(3, 1)).Select
    
End Sub
'

Lupin
0
Cc lupin dsl se weekend j'ai pas eu le temps de me connecter :)

bah ton code fonctionne parfaitement
j'ai juste enlevé les messages du avant / aprés trie

jais surment des petites adaptations à faire !

je te retiens au courant !
puis merci encore je ne demandais pas tant :)
0
ah mr lupin ya un petit soucis !

j'ai un exemple pu mes date sont tous dans l'ordre! et apré le trie jai des date de 2009 aprés 2010
je pense qui l fau les mettre en format date poour avoir un true correcte
0
Utilisateur anonyme
15 déc. 2008 à 13:31
re:

sans aucu n doute dy, il faut fair une mise en forme
exacte du format vers un format de type date.

C'est le but des i nstructions dans la boucle :

    ' Capture des noms de feuilles dans Tableau et formatage de la date
    For Boucle = 1 To Limite
        Valeur = Mid(Sheets(Boucle).Name, 10, 8)
        Valeur = Format(Valeur, "dd-mm-yy")
        Valeur = Format(Valeur, "yyyy-mm-dd")
        Tableau(Boucle, 0) = Valeur: Tableau(Boucle, 1) = Boucle
    Next Boucle


Lupin
0
oui
mes date de mes feuilles sont bien au format JJ-MM-AA

dans ton code
' Capture des noms de feuilles dans Tableau et formatage de la date
    For Boucle = 1 To Limite
        Valeur = Mid(Sheets(Boucle).Name, 10, 8)
        Valeur = Format(Valeur, "dd-mm-yy")
        'Valeur = Format(Valeur, "yyyy-mm-dd")
        Tableau(Boucle, 0) = Valeur: Tableau(Boucle, 1) = Boucle
    Next Boucle 

j'ai mis en commentaire 'Valeur = Format(Valeur, "yyyy-mm-dd") car j'utilise

Valeur = Format(Valeur, "dd-mm-yy")
0
ah méa culpa je pensé que tu me laissé le choix dans ton code
entre Valeur = Format(Valeur, "dd-mm-yy")
et
Valeur = Format(Valeur, "yyyy-mm-dd")

en effet si je laisse les deux c'est ok
au pire je referais une boucle dans mon tableau
si je veus remettre les dates en dd-mm-yy
0
Utilisateur anonyme
15 déc. 2008 à 14:19
re :

au premier [ MsgBox ], qu'elle est le format de date que le programme
t'affiche ?

Lupin
0
15/12/2008
0
la date sortir pas excel change donc selon les machines ?
0
Utilisateur anonyme
15 déc. 2008 à 15:46
re:

le format de date changent selon les paramètres régionaux configurés de WXP.

donc tu devaris retrouver quelques chose comme :

    For Boucle = 1 To Limite
        Valeur = Mid(Sheets(Boucle).Name, 10, 8)
        Valeur = Format(Valeur, "dd-mm-yyyy")
        Valeur = Format(Valeur, "yyyy-mm-dd")
        Tableau(Boucle, 0) = Valeur: Tableau(Boucle, 1) = Boucle
    Next Boucle 

Lupin
0