Macro pour fichier CSV

Bonjour,

Tout d'abord en cas de doute :

"Format CSV

Un fichier CSV est un fichier tableur, contenant des données sur chaque ligne séparés par un caractère de séparation (généralement une virgule, un point-virgule ou une tabulation). "

Voilà j'ai donc établi un fichier CSV pour aller chercher des plans pour mon travail sur le serveur Général.

Le processus de sélection des plans ne nous intéresse pas et est déjà traité (les chiffres en début de ligne correspondent à 0 : je veux pas le plan, 1: je le veux)

En l'état les plans sortent dans l'ordre des lignes. J'aimerai créer une macro pour les "ranger" dans un sens bien défini.

Ici il n'y a que 4 plans qui m'intéressent : Vue Générale, Vue Cuisine 1 et 2 et vue extérieure.(normalement j'ai environ 40 plans)

Pour le test j'aimerai que les lignes se rangent comme suis :

Vue Générale

Vue Cuisine 1

Vue Cuisine 2

Vue Générale (non ce n'est pas une erreur )

Vue extérieure.

Si vous pouviez me guider. Merci

Bonsoir,

voici une macro qui te permet de trier ton fichier csv sur base du contenu de la colonne édition. où plutôt que d'avoir des 0 et des 1, je te propose d'y indiquer ta préférence de tri (tu peux répéter des lignes en indiquant plusieurs préférences de tri, séparées par une virgule par exemple 1,4 pour indiquer que tu veux que cette ligne apparaisse en ligne 1 et en ligne 4 dans le document final. j'ai adapté ton csv à titre d'exemple.

dis-moi si cette manière de faire peut te convenir.

la macro est à insérer dans un nouveau classeur où sera généré le résultat..

Sub test()
    Dim a As Variant
    Set wsp = Workbooks("PlanDiapason.csv").Worksheets(1)
    Set wst = ThisWorkbook.Worksheets(1)
    wst.Cells.Clear
    wsp.Rows(1).Copy wst.Range("A1")
    i = 2
    l = 1
    While wsp.Cells(i, 1) <> ""
        If wsp.Cells(i, 1) <> "0" Then
            a = Split(wsp.Cells(i, 1), ",")
            For j = 0 To UBound(a, 1)
                l = l + 1
                wsp.Rows(i).Copy wst.Range("A" & l)
                wst.Cells(l, 1) = a(j)
            Next j
        End If
        i = i + 1
    Wend
    With wst.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & l), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        .SetRange Range("A1:J" & l)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Set wst = Nothing
    Set wsp = Nothing
End Sub

Bonsoir,

Merci de ta réponse.

Je ne connais pas trop le principe du CSV...

les 1, veulent simplement dire qu'il me les faut et les placent les uns derrière les autres? mais si on mais 1,5,8,9 alors leurs positions s'adaptent à cette "commande"?

Si c'est ça OK. Je voudrais en fait que les lignes suivent une logique de classement qui soit toujours la même (c'est ce que je m'imaginais).Par exemple dans un fichier je mets dans une colonne l'ordre des plans et que la macro vienne comparer/trier/réorganiser en fonction de cet ordre.

Rien que ça

J'ai déjà fait ce principe pour mettre directement des "1" sur le fichier xls transformé en CSV pour sélectionner que les plans qui m'intéressent.

Pour ta macro, mon dieu je connais un peu mais là tu m'as perdu^^

Je ne peux pas tester en direct étant actuellement en vacance.

Bonjour,

j'ai une piste mais pour cela je dois faire une recherche précise par exemple :

Dim X As Integer
    X = 1
    While X <= 2
    Cells.Find(What:="implantation C", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    Windows("macro hide.xlsm").Activate
    Sheets("plandiapason1").Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("modif plansdiap").Select
     ActiveCell.Offset(1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("PlanDiapason-3.csv").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    X = X + 1
    Wend

En fait je recherche un plan et grâce à un copié collé dans un fichier prédéfini + formule remplace j'obtiens le résultat voulu.

Seul soucis ici ma boucle implique qu'il y est au moins 2 ligne avec "implantation C" sinon ça bug, pouvez vous m'aider pour faire une boucle identique mais qui regarde d'abord si il y a une autre ligne?

Genre si une autre ligne "implantation C" avec alors exécuter la macro si pas d'autre ligne alors continuer.

Merci

Up

Bonjour,

pas compris ce que tu cherches à faire (par rapport à ta demande initiale), mais essaie ceci comme solution pour ta dernière demande.

Dim X As Integer
    X = 1
    While X <= 2
   set re= Cells.Find(What:="implantation C", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    if not re is nothing then
    re.Copy
    Windows("macro hide.xlsm").Activate
    Sheets("plandiapason1").Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("modif plansdiap").Select
     ActiveCell.Offset(1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("PlanDiapason-3.csv").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
end if    
X = X + 1

    Wend

"Bonjour,

pas compris ce que tu cherches à faire (par rapport à ta demande initiale), mais essaie ceci comme solution pour ta dernière demande."

En fait tu m'as aidé à comprendre que si je modifie les "1," en début de lignes du fichier CSV , alors je modifies l'ordre d'affichage.

J'ai donc fait en sorte que la modification se fasse grâce à la formule (REMPLACER) de excel. (en passant par un autre fichier d'où les différents copié/collé de ma macro)

Pour ta macro on y est presque ! Là le résultat permet bien de rechercher 8 fois ma demande, mais en fait j'aimerai qu'il cherche une fois qu'il fasse mes copié/collé, et que si sur la recherche suivante il ne trouve rien il passe à autre chose dans ma macro. Car là en fait il rebalaye tout le document et forcément retrouve ma demande.

J'essaye avec "Cells.FindNext(After:=ActiveCell)" mais ça marche pas...

Merci en tout cas

Bonjour,

essaie ceci. pas possible pour moi de tester..

Dim X As Integer
    X = 1
    Set re = Range("G1")
    While X <= 2
   Set re = Columns("G").Find(What:="implantation C", After:=re, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not re Is Nothing Then
    re.Copy
    Windows("macro hide.xlsm").Activate
    Sheets("plandiapason1").Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("modif plansdiap").Select
     ActiveCell.Offset(1, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("PlanDiapason-3.csv").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
X = X + 1

    Wend

Incompatibilité de type sur

Set re = Columns("G").Find(What:="implantation C", After:=re, LookIn:=xlValues, _

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False)

;(

Alors,

j'ai remplacé "G" par "A" et ça marche MAIS :

Si je mets :

 While X <= 8

Car parfois j'ai jusqu'à 8 fois ce plan, mais imaginons que pour un produit j'en ai que 2 (plans et donc lignes):

Plan G

Plan G 2

à la fin de la 1ére boucle la recherche recommence en "ht" du document et retrouve donc Plan G puis PLan G 2....

il le fait donc 4 fois. Et pour moi c'est gênant (emmerdeur )

as-tu bien copié cette ligne ?

 Set re = Range("G1")

le code suivant fonctionne chez moi

Sub test()
' selectionner l'onglet dans lequel la recherche doit se faire avant de lancer la macro

    Dim X As Integer
    X = 1
    l = 0
    Set re = Range("G1")
    While X <= 2
        Set re = Columns("G").Find(What:="implantation C", After:=re, LookIn:=xlValues, _
                                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                   MatchCase:=False, SearchFormat:=False)
        If Not re Is Nothing Then
        l = l + 1
            re.EntireRow.Copy Worksheets("feuil1").Cells(l, 1) 'l'onglet feuil1 doit exister
        End If
        X = X + 1

    Wend
End Sub

autre proposition

Sub test()
    Dim X As Integer
    X = 1
    l = 0
    Set re = Range("G1")
    fin = False
    rr = 0
    Do
        Set re = Columns("G").Find(What:="implantation C", After:=re, LookIn:=xlValues, _
                                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                   MatchCase:=False, SearchFormat:=False)
        If Not re Is Nothing Then
            If re.Row > rr Then
                l = l + 1
                re.EntireRow.Copy Worksheets("feuil1").Cells(l, 1)
                rr = re.Row
            Else
                fin = True
            End If
        Else
            fin = True
        End If
        X = X + 1
        If X = 4 Then fin = True
    Loop Until fin
End Sub

ce que j'ai lu :

Les méthodes FindNext et FindPrevious permettent de répéter la recherche.

Lorsque la recherche atteint la fin de la plage de recherche spécifiée, elle revient au début de cette plage. Pour arrêter une recherche lorsqu'elle revient au point de départ, enregistrez l'adresse de la première cellule trouvée, puis comparez l'adresse de chaque cellule ultérieurement trouvée avec l'adresse enregistrée.

Ok...

Désolé ça ne marche pas la boucle s'arrête avant. ou du moins on passe directement de

If Not re Is Nothing Then

Else

j'ai fait, et qui fonctionne :

Dim X As Integer
   X = 1
   pc = 2
   dc = 1
   Set Re = Range("A1")
   While X <= 8
    If Not pc = dc Then
    Set Re = Columns("A").Find(What:="implantation Cu", After:=Re, LookIn:=xlValues, _
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
          MatchCase:=False, SearchFormat:=False)
          pc = ActiveCell.Row
       If Not Re Is Nothing Then
            Re.Copy
            Windows("macro hide.xlsm").Activate
            Sheets("plandiapason1").Select
            Range("A2").Select
            ActiveSheet.Paste
            Sheets("modif plansdiap").Select
            Range("A2").Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("PlanDiapason-3.csv").Activate
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            If X = 1 Then
            ActiveCell.Offset(1, 0).Select
            Else
            End If
            dc = ActiveCell.Row
        Else
        End If
    Else

en revanche peut on mettre une condition pour que si la valeur recherché = 0 alors on passe au suivant? parce que ça marche si je laisse X<= 1 mais si j'augmente ça bug...

ça me met incompatibilité de type erreur 13/

modif en bas qui fonctionne

a voir au taf

Dim X As Integer

X = 1

pc = 2

dc = 1

Set Re = Range("A1")

While X <= 8

If Not pc = dc Then

Set Re = Columns("A").Find(What:="implantation Cu", After:=Re, LookIn:=xlValues, _

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False)

pc = ActiveCell.Row

If Not Re Is Nothing Then

Re.Copy

Windows("macro hide.xlsm").Activate

Sheets("plandiapason1").Select

Range("A2").Select

ActiveSheet.Paste

Sheets("modif plansdiap").Select

Range("A2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("PlanDiapason-3.csv").Activate

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

If X = 1 Then

ActiveCell.Offset(1, 0).Select

dc = pc

Else

dc = ActiveCell.Row

End If

Else

X = 8

End If

Else

End If

X = X + 1

Wend