Macro excel pour tri de données et récupération d'information en tête de ligne

hydrogeologue

XLDnaute Nouveau
N'étant pas un grand spécialiste en VBA je demande votre aide concernant la mise en forme d'un tableau suivant :

!Données Affluent : 3 Pas= 6
! Long Cum Flow_Riv Colon Ligne
640.5 1308000 131 43
24482.5 3835000 128 25

!Données Affluent : 4 Pas= 8
! Long Cum Flow_Riv Colon Ligne
610.5 120800 146 53
1784 0 146 52
23757.5 5588000 141 37

etc..........

Au format suivant :
Récupérer la données pas= x pour le mettre en colonne en face des données

! Long Cum Flow_Riv Colon Ligne
Pas= 6 640.5 1308000 131 43
Pas= 6 24482.5 3835000 128 25
Pas= 8 610.5 120800 146 53
Pas= 8 1784 0 146 52
Pas= 8 23757.5 5588000 141 37


Je vous remercie d'avance pour l'aide que vous pourrez m'apporter....
 

hydrogeologue

XLDnaute Nouveau
Re : Macro excel pour tri de données et récupération d'information en tête de ligne

Mea culpa

Ci-joint un fichier exemple... avec une feuille de "Données" et une feuille "Resultat" espéré...
Merci....
 

Pièces jointes

  • Exemple.xlsx
    17 KB · Affichages: 24
  • Exemple.xlsx
    17 KB · Affichages: 23
  • Exemple.xlsx
    17 KB · Affichages: 23

camarchepas

XLDnaute Barbatruc
Re : Macro excel pour tri de données et récupération d'information en tête de ligne

Re ,

Voici donc un code à mettre dans un module standard .

Code:
Sub organise()
Dim Trouve As Range
Dim Pas As String, PremiereAdresse As String, Lecture As String
Dim Ligne As Long, Cible As Long

With Worksheets("Données").Range("A:A")
    Set Trouve = .Find("Affluent :", Lookat:=xlPart, LookIn:=xlValues)
    If Not Trouve Is Nothing Then
        Ligne = Trouve.Row
        PremiereAdresse = Trouve.Address
        Cible = 1
        Ligne = Ligne + 1
        Sheets("Resultats").Range("A" & Cible) = "Pas"
        Sheets("Resultats").Range("B" & Cible & ":R" & Cible).Value = Worksheets("Données").Range("A" & Ligne & ":Q" & Ligne).Value
        
        Do
            Ligne = Ligne + 1
            Pas = Trim(Split(Split(Trouve, "Pas=")(1), "t")(0))
            Do
            Cible = Cible + 1
            Sheets("Resultats").Range("A" & Cible) = Pas
            Sheets("Resultats").Range("B" & Cible & ":R" & Cible).Value = Worksheets("Données").Range("A" & Ligne & ":Q" & Ligne).Value
            Ligne = Ligne + 1
            Lecture = Worksheets("Données").Range("A" & Ligne)
            Loop Until Lecture = ""
            Ligne = Ligne + 1
            Set Trouve = .FindNext(Trouve)
            Ligne = Ligne + 1
        Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresse
    End If
End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 104
Messages
2 085 326
Membres
102 862
dernier inscrit
Emma35400