Discussion :

[Moowgli]

Bonjour,
Je viens, demander vos conseils et votre aide pour la réalisation d'une macro.

Pour info, j'utilise Microsoft Excel 2010,


Mon problème se décompose en deux sous problèmes :

1/ Optimisation de code
Je récupère une colonne (B), j'aimerais supprimer les doublons sur cette colonne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub supprimeDoublons()
MaCellule = "B2" '      
'Récupère l 'adresse de la cellule dans une variable MaCellule
Range(MaCellule).Select                                                                     'Sélectionne la cellule indiquée
ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes        
'Trie le tableau sur cette celule
donnee1 = ActiveCell                                                                            'Mémorise le contenu de la cellule en cours et l'affecte à donnee1
ActiveCell.Offset(1, 0).Select                                                                  'Descend d 'une ligne
While ActiveCell <> ""              
'tant que la cellule n'est pas vide
If ActiveCell = donnee1 Then        
'vérifie si le contenu de la cellule en cours est égal à donnee1
ActiveCell.EntireRow.Delete         
'si oui, supprime la ligne entière
ActiveCell.Offset(-1, 0).Select    
 'remonte d 'une ligne
donnee1 = ActiveCell                
'mémorise à nouveau le contenu de la cellule
ActiveCell.Offset(1, 0).Select      
'descend d 'une ligne
Else                                
'sinon
donnee1 = ActiveCell               
'mémorise le contenu de la cellule en cours de la ligne suivante et l'affecte à donnee1
ActiveCell.Offset(1, 0).Select      
'descend d 'une ligne
End If                              
'fin de la vérification
Wend                               
'Fin de la boucle (on répète les instructions tant que la cellule en cours d'examen contient quelque chose). Sinon, le programme s'arrête
End Sub

Malheureusement, ce code est beaucoup trop long a l’exécution (comparer au bouton supprimer les doublons de l'onglet Données), quelqu'un aurait il une solution en vue de l'optimiser ?

Une fois mes doublons supprimer, je réalise une copie du résultat dans une autre colonne (G).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub ListeAlarmes()
Worksheets("Conversion").Activate                                           
'Active l'onglet Conversion
Range("B2").Select                                                         
'Selectionne la colonne B case 2
Worksheets("Conversion").Range("B2:B100").Copy                            'Selectionne la plage de B2 à B65536 pour la copie
ActiveSheet.Paste Destination:=Worksheets("Conversion").Range("G2:G100")     'Active le collage dans le classeur Conversion, plage G2 à G65536
End Sub

Une fois mes doublons supprimer j'aimerais remplacer le caractère "/" par un "_", a l'heure actuelle j'utilise une formule excel du type :
=SUBSTITUE(G2;"/";"_"), dans la colonne I, je met le résultat de la substitution.

Bien entendu, si je pouvais réaliser la suppression des doublons et le remplacement de caractère dans la même fonction cela serait beaucoup mieux.


2/ Création de fichier texte
Une fois ma colonne créer, (sans doublons et avec les caractères remplacer),
je souhaite créer autant de fichier texte qu'il y a de ligne rempli dans la colonne G , le contenu de ce fichier texte étant le contenu de la colonne J et le nom de ce fichier texte le contenu de la colonne G.

Si quelqu'un a des idées ou un exemple de code..?


Je reste ouvert a tout complément
Cordialement,

[Manu3100]

Salut,

Pour la parti, 1 - Optimisation de code, je te propose ce code. Il utilise le dictionnaire (il faut activer la reference Miscrosoft Script). Et j'ai rajouter a la fin du code une partie pour remplacer le caractère "/" par un "_".

Test:
14'000 lignes en 1m40s ( je ne sais pas si c'est assez rapide pour toi)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub Doublon()
 
Dim dict As Object
Dim rowCount As Long
Dim strVal As String
Dim wb As Workbook
Dim ws As Worksheet
 
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
 
Set dict = CreateObject("Scripting.Dictionary")
 
rowCount = ws.Range("B1").CurrentRegion.Rows.Count
 
Do While rowCount > 0
    strVal = Sheet1.Cells(rowCount, 2).Value2
 
        If dict.exists(strVal) Then
            ws.Rows(rowCount).EntireRow.Delete
        Else
            dict.Add strVal, 0
        End If
 
    rowCount = rowCount - 1
Loop
 
Set dict = Nothing
 
'remplacer le caractère "/" par un "_"
 
lastrow = ws.Range("B" & Rows.Count).End(xlUp).Row
 
Dim rng As Range, cell As Range
Set rng = ws.Range("B2:B" & lastrow)
 
    For Each cell In rng
 
        cell = Replace(cell.Value, "/", "_")
    Next
 
End Sub

Et pour la parti 2)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub textFile()
 
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
 
LastRow = Range("G" & Rows.Count).End(xlUp).Row
LastRow2 = Range("J" & Rows.Count).End(xlUp).Row
 
Set rng = Range("G2:G" & LastRow)
Set rng2 = Range("J2:J" & LastRow2)
For Each cell In rng
 
myFile = Application.DefaultFilePath & "\" & cell.Value & ".txt"
 
Open myFile For Output As #1
 
For i = 2 To rng2.Rows.Count
    For j = 1 To rng2.Columns.Count
 
        cellValue = rng2.Cells(i, j).Value
 
            If j = rng2.Columns.Count Then
                 Write #1, cellValue
            Else
                Write #1, cellValue,
            End If
 
    Next j
Next i
 
Close #1
Next
End Sub

Manu

[clementmarcotte]

Bonjour à tous les deux,

Pour la question numéro 1, il existe une petite merveille dans Excel, qui s'appelle le Filtre avancé (filtre élaboré dans l'ancien temps).

Avec cela, on peut filter une feuille et le faire sans doublon. Même que l'on peut mettre les résultats filtrés automatiquement dans une nouvelle feuille ou une nouvelle feuille.

[DonkeyPuncher]

Bonjour,

Il existe également la fonction RemoveDuplicates pour supprimer les doublons d'une plage donnée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.Range("A1:C100").RemoveDuplicates

[patricktoulon]

Bonjour a tous
donkey oui en effet il y a cette solution depuis 2007 mais attention il ne veut peut etre pas modifier le sheets

et enfin je trouve que vous avez toute cette mauvaise manie de boucler sur les cellules alors que boucler sur un tableau(variable variant )et beaucoup plus rapide puisque tout ce passe en memoire

ensuite pourquoi supprimer les doublons puis recommencer la boucle pour remplacer les caracteres alors que l'on peut faire tout ca d'un coup

voici un exmpl quitilse un taleau,un dico et teste les valeur dans le dico deja transformées et les place dans la variable texte
et enfin creation du fichier texte
avec la creation d fichier texte ca devrait pas prendre pus de 3 ou 4 seconde sur 0000 lignes

j'ai pas testé mais le principe c'est ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub test()
    Dim dico As Object, i, e, tablo, texte, fichier As String
    Set dico = CreateObject("Scripting.dictionary")    'on créé un dictionaire
    tablo = Sheets(x).Range("b2:b" & Sheets(x).Cells(Rows.Count, 2).End(xlUp).Row) .value
   'on prend la plage utiliée dans la colone B jusqu'a la derniere ligne il te faut adapter le (sheets(x)!!!!!
    ' maintenant dans une boucl on va suprimer les doublons en testant le  dictionaire et metant la valeur dans la variable texte
    For i = Lbound(tablo) To UBound(tablo)
        If Not dico.exists(Replace(tablo(i), "/", "-")) Then    'on teste directement si la valeur avec le remplacement (/,-) existe ou pas dans le dictionnaire
            texte = texte & Replace(tablo(i), "/", "-") & vbCrLf    'on la met dans la variable texte
            dico(Replace(tablo(i), "/", "-")) = ""    'et on la met dans le dictionaire  pour le prochain tour
        End If
    Next
    'on créé maintenant le fichier texte 
   fichier = "C:\Users\polux\Desktop\test2.txt"    ' adapte ton chemin
    x = FreeFile
    Open fichier For Output As #x
    Print #x, texte
    Close #x
End Sub

[Moowgli]

Merci pour les exemples de codes et les explications.
Pour ce qui est du filtre avancé, il m'est imposer de passer par une macro... .

La fonction RemoveDuplicates a l'air intéressante, mais je préfère comprendre et mettre en place le script de patricktoulon, qui a l'air plus complet.

D'ailleurs, j'aurais besoin d'aide pour bien comprendre cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tablo = Sheets(Conversion).Range("B2:B" & Sheets(Conversion).Cells(Rows.Count, 2).End(xlUp).Row).Value

Dans un premier temps on sélectionne la plage à copier?
Que signifie l'autre partie du code?

De même, si quelqu'un peut expliquer en bref les instructions du script de Manu.


Encore merci pour vos compléments qui me permettent de m'améliorer dans ma jeune programmation de macro en VBA.