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

[pingouinal]

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]

Bonjour Pingouinal,
Un essai en PJ avec :

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éé.

 

[pingouinal]

Merci beaucoup. Je n'avais pas pensé à vérifier le nom du fichier, je vais donc partir là-dessus et l'adapter à mon besoin.