bonjour,
Bonjour,
Je possède plusieurs dictionnaires *.dic, et je veux n'en faire qu'un. Sous
Excel, je les ai mis à la suite dans la colonne A. Celui issu de Netscape
présente des mots sans les traits d'union pour les noms composés. J'ai donc
bricolé une macro, mais pas très rapide. Quelqu'un aurait-il quelque chose de
plus efficace ?
Merci d'avance.
Ggal
Sub tri()
Columns(1).Sort key1:=Range("a1")
n = 1
k = Range("a65536").End(xlUp).Row
For i = 1 To k
If Range("a" & n) = Range("a" & n + 1) Then
Range("a" & n).Delete shift:=xlShiftUp
k = k - 1
n = n - 1
End If
n = n + 1
Next i
t = 2
For j = 2 To k
tmp_1 = Range("a" & t)
For i = 1 To Len(tmp_1)
If Mid(tmp_1, i, 1) = "-" Then
tmp_1 = Left(tmp_1, i - 1) & Mid(tmp_1, i + 1)
End If
Next i
If tmp_1 = Range("a" & t - 1) Then
Range("a" & t - 1).Delete shift:=xlShiftUp
k = k - 1
t = t - 1
End If
t = t + 1
Next j
End Sub
k = Range("a65536").End(xlUp).Row For i = k To 2 Step -1 If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value Then Range("a" & i - 1).Delete shift:=xlShiftUp End If Next i
End Sub
j-p
au final, ca donnerait :
Sub tri()
Columns(1).Sort key1:=Range("a1")
k = Range("a65536").End(xlUp).Row
For i = k To 2 Step -1
If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value Then
Range("a" & i - 1).Delete shift:=xlShiftUp
End If
Next i
k = Range("a65536").End(xlUp).Row For i = k To 2 Step -1 If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value Then Range("a" & i - 1).Delete shift:=xlShiftUp End If Next i
End Sub
j-p
GGAL
OK, ça marche, je vais tester la vitesse. GGAL
au final, ca donnerait :
Sub tri() Columns(1).Sort key1:=Range("a1")
k = Range("a65536").End(xlUp).Row For i = k To 2 Step -1 If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value Then Range("a" & i - 1).Delete shift:=xlShiftUp End If Next i
End Sub
j-p
OK, ça marche, je vais tester la vitesse.
GGAL
au final, ca donnerait :
Sub tri()
Columns(1).Sort key1:=Range("a1")
k = Range("a65536").End(xlUp).Row
For i = k To 2 Step -1
If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value Then
Range("a" & i - 1).Delete shift:=xlShiftUp
End If
Next i
k = Range("a65536").End(xlUp).Row For i = k To 2 Step -1 If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value Then Range("a" & i - 1).Delete shift:=xlShiftUp End If Next i
End Sub
j-p
jps
on dit OK, ça marche, MERCI jps
"GGAL" a écrit dans le message de news:
OK, ça marche, je vais tester la vitesse. GGAL
au final, ca donnerait :
Sub tri() Columns(1).Sort key1:=Range("a1")
k = Range("a65536").End(xlUp).Row For i = k To 2 Step -1 If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value Then Range("a" & i - 1).Delete shift:=xlShiftUp End If Next i
End Sub
j-p
on dit OK, ça marche, MERCI
jps
"GGAL" <GGAL@discussions.microsoft.com> a écrit dans le message de news:
71F68605-6F40-4A43-92EC-1DE6AB525E84@microsoft.com...
OK, ça marche, je vais tester la vitesse.
GGAL
au final, ca donnerait :
Sub tri()
Columns(1).Sort key1:=Range("a1")
k = Range("a65536").End(xlUp).Row
For i = k To 2 Step -1
If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value
Then
Range("a" & i - 1).Delete shift:=xlShiftUp
End If
Next i
k = Range("a65536").End(xlUp).Row For i = k To 2 Step -1 If Replace(Range("a" & i).Value, "-", "") = Range("a" & i - 1).Value Then Range("a" & i - 1).Delete shift:=xlShiftUp End If Next i
End Sub
j-p
Garette
Bonsoir,
Voici un petit bout de code qui nettoie les doublons et qui enlève les mots qui n'ont pas de tiret (et qui devraient en avoir). On doit pouvoir optimiser un peu le code. Ca gere bien qd il y a plusieurs tirets . Tiens moi au courant si ça marche chez toi. Je n'ai fait le test que sur une petite zone.
Sub Nettoyeur Dictionnaire()
'Définition de la zone à traiter + tri k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1)) MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons For Each CellTest In MaZone If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents Next
'Définition de la nouvelle zone à traiter + tri (supprime les vides) MaZone.Sort key1:Îlls(1, 1) k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets For Each CellTest In MaZone Select Case InStr(1, CellTest, "-") <> 0 Case CellTest.Row = 1 'Ne fait rien s'il y a un mot avec tiret dans la 1ere ligne Case Replace(CellTest, "-", "") = CellTest.Offset(-1, 0).Resize(1, 1) CellTest.Offset(-1, 0).Resize(1, 1).ClearContents End Select Next MaZone.Sort key1:Îlls(1, 1)
End Sub
Bonsoir,
Voici un petit bout de code qui nettoie les doublons et qui enlève les mots
qui n'ont pas de tiret (et qui devraient en avoir).
On doit pouvoir optimiser un peu le code.
Ca gere bien qd il y a plusieurs tirets .
Tiens moi au courant si ça marche chez toi. Je n'ai fait le test que sur une
petite zone.
Sub Nettoyeur Dictionnaire()
'Définition de la zone à traiter + tri
k = Range("a65536").End(xlUp).Row
Set MaZone = Range(Cells(1, 1), Cells(k, 1))
MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons
For Each CellTest In MaZone
If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents
Next
'Définition de la nouvelle zone à traiter + tri (supprime les vides)
MaZone.Sort key1:Îlls(1, 1)
k = Range("a65536").End(xlUp).Row
Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets
For Each CellTest In MaZone
Select Case InStr(1, CellTest, "-") <> 0
Case CellTest.Row = 1 'Ne fait rien s'il y a un mot avec tiret dans la
1ere ligne
Case Replace(CellTest, "-", "") = CellTest.Offset(-1, 0).Resize(1, 1)
CellTest.Offset(-1, 0).Resize(1, 1).ClearContents
End Select
Next
MaZone.Sort key1:Îlls(1, 1)
Voici un petit bout de code qui nettoie les doublons et qui enlève les mots qui n'ont pas de tiret (et qui devraient en avoir). On doit pouvoir optimiser un peu le code. Ca gere bien qd il y a plusieurs tirets . Tiens moi au courant si ça marche chez toi. Je n'ai fait le test que sur une petite zone.
Sub Nettoyeur Dictionnaire()
'Définition de la zone à traiter + tri k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1)) MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons For Each CellTest In MaZone If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents Next
'Définition de la nouvelle zone à traiter + tri (supprime les vides) MaZone.Sort key1:Îlls(1, 1) k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets For Each CellTest In MaZone Select Case InStr(1, CellTest, "-") <> 0 Case CellTest.Row = 1 'Ne fait rien s'il y a un mot avec tiret dans la 1ere ligne Case Replace(CellTest, "-", "") = CellTest.Offset(-1, 0).Resize(1, 1) CellTest.Offset(-1, 0).Resize(1, 1).ClearContents End Select Next MaZone.Sort key1:Îlls(1, 1)
End Sub
GGAL
Bonsoir Garette
La suppression de tous les doublons se fait bien, mais pas les mots sans traits d'union. Une erreur d'exécution 1004 est renvoyée à ce stade. Il reste par exemple : arcenciel arc-en-ciel mer tireauflanc tire-au-flanc
D'autre part, si à la maison j'ai Excel 2003, au travail c'est Excel 97, qui n'intègre pas la fonction Replace. Une procédure «universelle» m'arrangerait. merci GGAL
Bonsoir Garette
La suppression de tous les doublons se fait bien, mais pas les mots sans
traits d'union.
Une erreur d'exécution 1004 est renvoyée à ce stade.
Il reste par exemple :
arcenciel
arc-en-ciel
mer
tireauflanc
tire-au-flanc
D'autre part, si à la maison j'ai Excel 2003, au travail c'est Excel 97, qui
n'intègre pas la fonction Replace. Une procédure «universelle» m'arrangerait.
merci
GGAL
La suppression de tous les doublons se fait bien, mais pas les mots sans traits d'union. Une erreur d'exécution 1004 est renvoyée à ce stade. Il reste par exemple : arcenciel arc-en-ciel mer tireauflanc tire-au-flanc
D'autre part, si à la maison j'ai Excel 2003, au travail c'est Excel 97, qui n'intègre pas la fonction Replace. Une procédure «universelle» m'arrangerait. merci GGAL
Garette
Bonsoir GGAL,
Effectivement, c'est bizarre que ça ait pu fonctionner ... Laà c'est mieux : Sub Dictionnaire2() 'Définition de la zone à traiter k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1)) MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons For Each CellTest In MaZone If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents Next
'Définition de la nouvelle zone à traiter (supprime les vides) MaZone.Sort key1:Îlls(1, 1) k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets For Each CellTest In MaZone If CellTest.Row <> 1 And InStr(1, CellTest, "-") <> 0 Then If Replace(CellTest, "-", "") = CellTest.Offset(-1, 0).Resize(1, 1) Then CellTest.Offset(-1, 0).Resize(1, 1).ClearContents End If End If Next MaZone.Sort key1:Îlls(1, 1) End Sub
C'est bizarre que Replace ne fonctionne pas sous XL97. C'est issue du menu REchercher/Remplacer qui existe depuis longtemps dans Excel. Il faut inclure une petite procédure qui enlève les tirets ...
Bonsoir GGAL,
Effectivement, c'est bizarre que ça ait pu fonctionner ...
Laà c'est mieux :
Sub Dictionnaire2()
'Définition de la zone à traiter
k = Range("a65536").End(xlUp).Row
Set MaZone = Range(Cells(1, 1), Cells(k, 1))
MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons
For Each CellTest In MaZone
If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents
Next
'Définition de la nouvelle zone à traiter (supprime les vides)
MaZone.Sort key1:Îlls(1, 1)
k = Range("a65536").End(xlUp).Row
Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets
For Each CellTest In MaZone
If CellTest.Row <> 1 And InStr(1, CellTest, "-") <> 0 Then
If Replace(CellTest, "-", "") = CellTest.Offset(-1, 0).Resize(1, 1) Then
CellTest.Offset(-1, 0).Resize(1, 1).ClearContents
End If
End If
Next
MaZone.Sort key1:Îlls(1, 1)
End Sub
C'est bizarre que Replace ne fonctionne pas sous XL97.
C'est issue du menu REchercher/Remplacer qui existe depuis longtemps dans
Excel.
Il faut inclure une petite procédure qui enlève les tirets ...
Effectivement, c'est bizarre que ça ait pu fonctionner ... Laà c'est mieux : Sub Dictionnaire2() 'Définition de la zone à traiter k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1)) MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons For Each CellTest In MaZone If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents Next
'Définition de la nouvelle zone à traiter (supprime les vides) MaZone.Sort key1:Îlls(1, 1) k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets For Each CellTest In MaZone If CellTest.Row <> 1 And InStr(1, CellTest, "-") <> 0 Then If Replace(CellTest, "-", "") = CellTest.Offset(-1, 0).Resize(1, 1) Then CellTest.Offset(-1, 0).Resize(1, 1).ClearContents End If End If Next MaZone.Sort key1:Îlls(1, 1) End Sub
C'est bizarre que Replace ne fonctionne pas sous XL97. C'est issue du menu REchercher/Remplacer qui existe depuis longtemps dans Excel. Il faut inclure une petite procédure qui enlève les tirets ...
Garette
Hello,
Une version sans Replace ... on doit pouvoir faire plus simple ....
Sub Dictionnaire3() 'Définition de la zone à traiter k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1)) MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons For Each CellTest In MaZone If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents Next
'Définition de la nouvelle zone à traiter (supprime les vides) MaZone.Sort key1:Îlls(1, 1) k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets For Each CellTest In MaZone If CellTest.Row <> 1 And InStr(1, CellTest, "-") <> 0 Then '----------------------------------------------------- mavar = CellTest X = 1 While X <> 0 X = InStr(1, mavar, "-", 0) mavar = Left(mavar, X - 1) & Right(mavar, Len(mavar) - X) X = InStr(1, mavar, "-", 0) Wend '----------------------------------------------------- If mavar = CellTest.Offset(-1, 0).Resize(1, 1) Then CellTest.Offset(-1, 0).Resize(1, 1).ClearContents End If End If Next MaZone.Sort key1:Îlls(1, 1) End Sub
Hello,
Une version sans Replace ... on doit pouvoir faire plus simple ....
Sub Dictionnaire3()
'Définition de la zone à traiter
k = Range("a65536").End(xlUp).Row
Set MaZone = Range(Cells(1, 1), Cells(k, 1))
MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons
For Each CellTest In MaZone
If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents
Next
'Définition de la nouvelle zone à traiter (supprime les vides)
MaZone.Sort key1:Îlls(1, 1)
k = Range("a65536").End(xlUp).Row
Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets
For Each CellTest In MaZone
If CellTest.Row <> 1 And InStr(1, CellTest, "-") <> 0 Then
'-----------------------------------------------------
mavar = CellTest
X = 1
While X <> 0
X = InStr(1, mavar, "-", 0)
mavar = Left(mavar, X - 1) & Right(mavar, Len(mavar) - X)
X = InStr(1, mavar, "-", 0)
Wend
'-----------------------------------------------------
If mavar = CellTest.Offset(-1, 0).Resize(1, 1) Then
CellTest.Offset(-1, 0).Resize(1, 1).ClearContents
End If
End If
Next
MaZone.Sort key1:Îlls(1, 1)
End Sub
Une version sans Replace ... on doit pouvoir faire plus simple ....
Sub Dictionnaire3() 'Définition de la zone à traiter k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1)) MaZone.Sort key1:Îlls(1, 1)
'Suppression des doublons For Each CellTest In MaZone If CellTest = CellTest.Offset(1, 0).Resize(1, 1) Then CellTest.ClearContents Next
'Définition de la nouvelle zone à traiter (supprime les vides) MaZone.Sort key1:Îlls(1, 1) k = Range("a65536").End(xlUp).Row Set MaZone = Range(Cells(1, 1), Cells(k, 1))
'Suppression des mots sans tirets For Each CellTest In MaZone If CellTest.Row <> 1 And InStr(1, CellTest, "-") <> 0 Then '----------------------------------------------------- mavar = CellTest X = 1 While X <> 0 X = InStr(1, mavar, "-", 0) mavar = Left(mavar, X - 1) & Right(mavar, Len(mavar) - X) X = InStr(1, mavar, "-", 0) Wend '----------------------------------------------------- If mavar = CellTest.Offset(-1, 0).Resize(1, 1) Then CellTest.Offset(-1, 0).Resize(1, 1).ClearContents End If End If Next MaZone.Sort key1:Îlls(1, 1) End Sub
GGAL
Re] Les deux versions fonctionnent bien chez moi sous XL2003, reste à voir sous XL97, et la rapidité. Si l'on en croit la littérature, d'autres fonctions ne figurent pas dans XL97 et les versions antérieures : CallByName, FormatCurrency, FormatDateTime, FormatNumber, FormatPercent, InStrRev, Join, Replace, Split, StrReverse. Merci. GGAL
Re]
Les deux versions fonctionnent bien chez moi sous XL2003, reste à voir sous
XL97, et la rapidité.
Si l'on en croit la littérature, d'autres fonctions ne figurent pas dans
XL97 et les versions antérieures : CallByName, FormatCurrency,
FormatDateTime, FormatNumber, FormatPercent, InStrRev, Join, Replace, Split,
StrReverse.
Merci.
GGAL
Re] Les deux versions fonctionnent bien chez moi sous XL2003, reste à voir sous XL97, et la rapidité. Si l'on en croit la littérature, d'autres fonctions ne figurent pas dans XL97 et les versions antérieures : CallByName, FormatCurrency, FormatDateTime, FormatNumber, FormatPercent, InStrRev, Join, Replace, Split, StrReverse. Merci. GGAL
