ordonner des ligne dans un tableau selon du texte en VBA. exotique.

[victor2012]

Bonjour,
J’ai un tableau avec colonne 1 des dates, colonne 2 des pays, colonne 3 des indicateurs
Les noms de pays se répètent de temps en temps ( Dans le tableau ci-dessous, on voit que le japon est en ligne 1,2 puis 6,7,8)
Je souhaite que les lignes soient regroupées par pays (tous les JN ensemble) MAIS il faut que l’ordre d’apparition soit respecté. (ici par exemple il faut avoir le tableau 2, les lignes 6, 7, 8 se mettent apres 1,2)


Je n’arrive pas à faire mon code VBA….
HELP.

EXEMPLE TABLEAU 1

05/10/2012 01:50 JN Trade Balance - BOP Basis
05/10/2012 04:00 JN Tokyo Avg Office Vacancies (%)
05/10/2012 05:00 CH Trade Balance (USD)
05/10/2012 05:00 CH Exports YoY%
05/10/2012 05:00 CH Imports YoY%
05/10/2012 06:41 JN Bankruptcies (YoY)
05/10/2012 07:00 JN Eco Watchers Survey: Current
05/10/2012 07:00 JN Eco Watchers Survey: Outlook
05/10/2012 07:30 IN India Local Car Sales
05/10/2012 08:30 FR Bank of France Bus. Sentiment

EXEMPLE TABLEAU 2

05/10/2012 01:50 JN Trade Balance - BOP Basis
05/10/2012 04:00 JN Tokyo Avg Office Vacancies (%)
05/10/2012 06:41 JN Bankruptcies (YoY)
05/10/2012 07:00 JN Eco Watchers Survey: Current
05/10/2012 07:00 JN Eco Watchers Survey: Outlook
05/10/2012 05:00 CH Trade Balance (USD)
05/10/2012 05:00 CH Exports YoY%
05/10/2012 05:00 CH Imports YoY%
05/10/2012 07:30 IN India Local Car Sales
05/10/2012 08:30 FR Bank of France Bus. Sentiment

 

[jp14]

Re : ordonner des ligne dans un tableau selon du texte en VBA. exotique.

Bonjour et bienvenue sur le forum


Ci dessous un code à tester

Option Explicit
Sub travdem()
Dim Cellule1 As Range, Plg1 As Range, Cellule2 As Range
Dim Nomfeuille1 As String, Col1 As String
Dim Dl2 As Long
'parametre
Nomfeuille1 = "Feuil1"
Col1 = "B"
Dl2 = 2
'code
With Worksheets("Feuil1")
For Each Cellule1 In .Range(Col1 & "2:" & Col1 & .Range(Col1 & .Rows.Count).End(xlUp).Row)
    If Cellule1 <> "" Then
        .Rows(Cellule1.Row).Copy Destination:=Worksheets("Feuil2").Range("A" & Dl2)
        Dl2 = Dl2 + 1
         Do
            For Each Cellule2 In .Range(Col1 & Cellule1.Row + 1 & ":" & Col1 & .Range(Col1 & .Rows.Count).End(xlUp).Row)
                If Cellule1 = Cellule2 Then
                    .Rows(Cellule2.Row).Copy Destination:=Worksheets("Feuil2").Range("A" & Dl2)
                    Dl2 = Dl2 + 1
                    Cellule2 = ""
                End If
            Next Cellule2
            Exit Do
        Loop
        Cellule1 = ""
    End If
Next Cellule1

End With
End Sub

JP

 

[WUTED]

Re : ordonner des ligne dans un tableau selon du texte en VBA. exotique.

Bonjour Victor2012, JP,

Un fichier test en pièce jointe.

Bonne journée,
WUTED

 

[victor2012]

Re : ordonner des ligne dans un tableau selon du texte en VBA. exotique.

Bonjour à vous deux,
Merci pour votre réactivité.
J'ai commencé par le fichier de Wuted qui marche fort bien.. seulement mon fichier est plus long que l'exemple donné et les dates varient (cf exemple infra). OR il faut que les pays soient triés comme précedement mais par jour, autrement je souhaiterais avoir les pays triés pour le 05/09 puis pour le 05/10. J'ai donc refais le programme à partir de vos indications (en effet il faut que je permutte les lignes et pas seulement les valeurs comme dans le programme de Wuted car mon tableau comporte en réalité de nombreuse colonnes) , mais il ne marche pas. Les fonction Row sont en rouge, et il ne comprends pas que je veut selectionner la ligne j (j est une variable).
Comment faire?
Merci encore

Voici mon programme

Sub tri_par_pays()

Dim fin As Integer
fin = 2
While Cells(fin, 2) <> ""
fin = fin + 1
Wend
Dim i As Integer
Dim j As Integer

For i = 2 To fin
If Cells(i, 2) = Cells(i + 1, 2) Then
i = i + 1
End If
For j = i + 1 To fin
If Cells(j, 2) = Cells(i, 2) And Right(Cells(j, 1), 10) = Right(Cells(i, 1), 10) Then
Rows(j&":"&j).Select
Selection.Cut
Rows(i+1":"i+1).Select
Selection.Insert Shift:=xlDown

i = i + 1

End If
j = j + 1

Next j
Next i


End Sub


Ex de tableau plus complet. (il y a plus de colonnes en réalité)

05/09/2012 01:01 UK BRC Sales Like-For-Like YoY
05/09/2012 01:50 JN Official Reserve Assets
05/09/2012 07:00 JN Leading Index CI
05/09/2012 07:00 JN Coincident Index CI
05/09/2012 08:00 GE Exports SA (MoM)
05/10/2012 01:50 JN Trade Balance - BOP Basis
05/10/2012 04:00 JN Tokyo Avg Office Vacancies (%)
05/10/2012 05:00 CH Trade Balance (USD)
05/10/2012 05:00 CH Exports YoY%
05/10/2012 05:00 CH Imports YoY%
05/10/2012 06:41 JN Bankruptcies (YoY)
05/10/2012 07:00 JN Eco Watchers Survey: Current
05/10/2012 07:00 JN Eco Watchers Survey: Outlook
05/10/2012 07:30 IN India Local Car Sales
05/10/2012 08:30 FR Bank of France Bus. Sentiment

 

[Grand Chaman Excel]

Re : ordonner des ligne dans un tableau selon du texte en VBA. exotique.

Bonjour victor2012 et bienvenue sur le forum,

Au lieu qu'on ait à tout retaper, serait-il possible de joindre ton fichier avec quelques lignes de données.
Note : As-tu essayé de faire un tri sur les données (par Date, Heure et Pays) ?

A+

 

[jp14]

Re : ordonner des ligne dans un tableau selon du texte en VBA. exotique.

Bonjour

Ci dessous la procédure modifiée
Sélection d'un pays en fonction de leur apparition dans la liste.
Transfert des données dans la feuille 2
Tri des données en fonction de la date et transfert des cellules dans la feuille3
En résumé sélection puis tri.

Option Explicit
Sub travdem()
Dim Cellule1 As Range, Plg1 As Range, Cellule2 As Range
Dim Nomfeuille1 As String, Col1 As String
Dim Dl2 As Long
'parametre
Nomfeuille1 = "Feuil1"
Col1 = "B"
Dl2 = 1
'code
With Worksheets("Feuil1")
For Each Cellule1 In .Range(Col1 & "2:" & Col1 & .Range(Col1 & .Rows.Count).End(xlUp).Row)
    If Cellule1 <> "" Then
        .Rows(Cellule1.Row).Copy Destination:=Worksheets("Feuil2").Range("A" & Dl2)
        Dl2 = Dl2 + 1
         Do
            For Each Cellule2 In .Range(Col1 & Cellule1.Row + 1 & ":" & Col1 & .Range(Col1 & .Rows.Count).End(xlUp).Row)
                If Cellule1 = Cellule2 Then
                    .Rows(Cellule2.Row).Copy Destination:=Worksheets("Feuil2").Range("A" & Dl2)
                    Dl2 = Dl2 + 1
                    Cellule2 = ""
                End If
            Next Cellule2
            Exit Do
        Loop
        Cellule1 = ""
        'Trier les données par date dans feuille 2
    Worksheets("Feuil2").Range("A1:E" & Dl2).Sort Key1:=Worksheets("Feuil2").Range("a1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        'copier les données dans la feuile3
      Worksheets("Feuil2").Range("A1:E" & Dl2).Copy Destination:=Worksheets("Feuil3").Range("A" & Worksheets("Feuil3").Range("a" & .Rows.Count).End(xlUp).Row + 1)
      Worksheets("Feuil2").Range("A1:E" & Dl2).Clear
        Dl2 = 1
    End If
Next Cellule1

End With
End Sub

JP