Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 [VBA] Trouver les occurrences différentes d'une liste

pingouinal

XLDnaute Occasionnel
Bonjour,

J'ai dans un fichier excel une liste avec des doublons (et potentiellement des vides). J'aimerais pour chacune des occurrences différentes dans cette liste créer un fichier.
Par exemple avec la liste ci-dessous, je voudrais générer 3 fichiers : France, Italie, Espagne.
Je pourrais faire un copier coller dans un autre onglet et supprimer les doublons via VBA pour avoir une liste plus simple, mais je pense qu'il y a plus propre pour l'avoir.
Le problème c'est que je ne sais pas dans quelle direction partir, d'où ma demande.

D'avance merci pour votre aide.


France
Espagne
France
Italie
Espagne
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Pingouinal,
Un essai en PJ avec :
VB:
Sub CreerFichiers()
    Dim Wkb, Nb%, Chemin$, NomFichier$, DL%, i%, Chaine$
    Application.ScreenUpdating = False
    Nb = 0: Chaine = ""
    Chemin = CurDir & "\"                                   ' A adapter suivant besoin
    DL = 1 + Range("A65500").End(xlUp).Row                  ' Colonne A à adapter
    For i = 1 To DL
        If Cells(i, "A") <> "" Then                         ' Colonne A à adapter
            NomFichier = Cells(i, "A") & ".xlsx"            ' Extension A à adapter
            If FichierExiste(Chemin & NomFichier) = False Then  ' Si le fichier n'existe pas
                Set Wkb = Workbooks.Add
                Wkb.SaveAs Chemin & NomFichier              ' Sauvegarde fichier
                Workbooks(NomFichier).Close                 ' Ferme fichier
                Chaine = Chaine & NomFichier & Chr(10)      ' Prépar message de sortie
                Nb = Nb + 1                                 ' Compte le nombre de fichiers crées.
                Application.StatusBar = "Nombre de fichiers créés : " & Nb
            End If
        End If
    Next i
    Application.ScreenUpdating = True
    Application.StatusBar = ""
    If Nb = 0 Then
        MsgBox "Tous les fichiers existent déjà."
    Else
        MsgBox "Fichiers crées dans " & Chemin & Chr(10) & Chr(10) & Nb & " fichier(s) créé(s) :" & Chr(10) & Chaine
    End If
End Sub
Function FichierExiste(Fichier As String)
' Renvoie True si le fichier existe, False s'il n'existe pas
On Error GoTo Fin:
   If Fichier <> "" And Len(Dir(Fichier)) > 0 Then
      FichierExiste = True
   Else
      FichierExiste = False
   End If
Exit Function
Fin:
    FichierExiste = CVErr(xlErrRef)
End Function
A adapter. Les fichiers sont créés dans le dossier où est enregistré cette PJ.
L'extension est xlsx, et la colonne analysée est la colonne A.
Les doublons sont traités automatiquement car si le fichier existe il n'est pas récréé.
 

Pièces jointes

  • CreerFichiers.xlsm
    17.1 KB · Affichages: 2
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…