OVH Cloud OVH Cloud

Traduction

10 réponses
Avatar
sonic
Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2 programmes ?

1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort Key1:=ActiveSheet.UsedRange.Cells(1)
lin = Columns(1).Find("*", , , , , xlPrevious).Row
encore:
keep = False
For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner", Type:=8)

If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub

10 réponses

Avatar
Christian M
C'est Modeste qui va être content ;-)))

--
Christian M
-------------------------------
"" a écrit dans le message de news:
bpd696$pje$
Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2 programmes ?

1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort Key1:¬tiveSheet.UsedRange.Cells(1)
lin = Columns(1).Find("*", , , , , xlPrevious).Row
encore:
keep = False
For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner", Type:=8)

If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub



Avatar
ru-th
Bon, je fais le premier !

Sub premier()
1er chant

ActiveSheet.UsedRange.EntireRow.Sort Key1:¬tiveSheet.UsedRange.Cells(1)
Entièrement rose,Le destin de l'herbe usée sera Un comme icelle fut usée

dans l'herbe
encore:
encore

keep = False
Gardes-toi du Faux

For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
Forts, ils étaient Un près de la colonne fine et rose

If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Icelle n'est plus icelle, mais gardait la Vérité

Next col
Derrière l'autre colonne

If keep = False Then Rows(lin).Delete
Gardes-toi du Faux car la rose s'enfuit

lin = lin - 1
loin, loin

If lin > 1 Then GoTo encore
loin et plus encore

End Sub
fin du chant


a+
rural thierry


"" a écrit dans le message de news:
bpd696$pje$
Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2 programmes ?

1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort Key1:¬tiveSheet.UsedRange.Cells(1)
lin = Columns(1).Find("*", , , , , xlPrevious).Row
keep = False
For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner", Type:=8)

If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub



Avatar
Paul V.
;-)
AMHA, le demandeur fait un sondage pour connaître le nombre de personne
capable de traduire.

Je propose donc que tous ceux qui le peuvent le fasse savoir.

Moi je peux ;-)

Et de un

A+

Paul V

Christian M wrote:
C'est Modeste qui va être content ;-)))

Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2 programmes ?

1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort
Key1:¬tiveSheet.UsedRange.Cells(1) lin = Columns(1).Find("*", , ,
, , xlPrevious).Row
encore:
keep = False
For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner", Type:=8)

If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub




Avatar
Modeste
Bonjour,
;-)))
Traduction(langue ?) ou explications ?????

sans connaitre les données ni leur disposition ???
la premiere macro effectue un tri des données de la
feuille active, en supprimant les lignes vides et les
doublons
la seconde macro marque les cellules non vides selon
contenu alpha (jaune) ou numérique (vert)

a quoi sert ensuite l'objet collection ???

En Français ?

Proc premier()
FeuilleActive.PlageUtilisée.LigneEntière.Trier
Clé1:þuilleActive.PlageUtilisée.Cellules(1)
lin = Colonnes(1).Rechercher("*"; ; ; ; ;
xlPrécédent).Ligne
encore:
keep = Faux
Pour col = 1 à Lignes(lin).Rechercher("*"; ; ; ; ;
xlPrécédent).Colonne
Si Cellules(lin; col) <> Cellules(lin - 1; col) Alors keep
= Vrai
Suivant col
Si keep = Faux Alors Lignes(lin).Supprimer
lin = lin - 1
Si lin > 1 Alors AllerA encore
Fin Proc

Proc Seconde()
Dcl Collec En New Collection; Cellule En Range; Plage En
Plage
Quand Erreur Reprendre Suivant
AffecteRéf Plage = Application.BoîteSaisie("Plage à
examiner"; Type:=8)
Si EstVide(Plage) Alors Sortir Proc
Pour Chaque Cellule Dans Plage
Si Cellule.Valeur <> "" Alors
Collec.Ajouter Cellule.Value; CChaîne
(Cellule.Valeur)
Si ErrCode <> 0 Alors
ErrCode.Effacer
Cellule.Intérieur.IndexCouleur = 43
Sinon
Cellule.Intérieur.IndexCouleur = 6
Fin Si
Fin Si
Suivant Cellule


@+

en Espagnol ;-))))


Proced premier()
HojaActiva.RangoUtilizado.FilaEntera.Ordenar
Criterio1:=HojaActiva.RangoUtilizado.Celdas(1)
lin = Columnas(1).Buscar("*", , , , , xlAnterior).Línea
encore:
keep = Falso
Para col = 1 Al Filas(lin).Buscar("*", , , , ,
xlAnterior).Columna
Si Celdas(lin, col) <> Celdas(lin - 1, col)
Entonces keep = Verdadero
Siguiente col
'Si keep = Falso Entonces Filas(lin).Eliminar
lin = lin - 1
Si lin > 1 Entonces IrA encore
Fin Proced

Proced Segundo()
Dim Collec QueSea New Collection, Celda QueSea Range,
Rango QueSea Rango
Dado Error Reanudar Siguiente
Definir Rango = Aplicación.CuadroEntrada("Rango Al
examiner", Tipo:=8)
Si EsVacío(Rango) Entonces Salir Proced
Para Cada Celda En Rango
Si Celda.Valor <> "" Entonces
Collec.Agregar Celda.Value, CCadena(Celda.Valor)
Si Err <> 0 Entonces
Err.Borrar
Celda.Interior.ÍndiceColor = 43
SiOtro
Celda.Interior.ÍndiceColor = 6
Fin Si
Fin Si
Siguiente Celda
Fin Proced



-----Message d'origine-----
Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2
programmes ?


1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort
Key1:¬tiveSheet.UsedRange.Cells(1)

lin = Columns(1).Find("*", , , , , xlPrevious).Row
encore:
keep = False
For col = 1 To Rows(lin).Find("*", , , , ,
xlPrevious).Column

If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As
Range


On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner",
Type:=8)


If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub

.



Avatar
Modeste
;-)))
je n'y avais pas pensé au premier abord,

j'ai réellement traduit (voir ma première réponse) la
macro en VBA français et Espagnol pour Excel 5 !!!!

mais au regard de la traduction effectuée par Thierry ,je
m'y lance, mes talents de traduction ci-dessous
proviennent de REVERSO qui me semble beaucoup moins
poétique que notre broutard.

en français REVERSO ?????

Sub Premier ministre ()
ActiveSheet. UsedRange. EntireRow. Tri(sorte) Key1 : =
ActiveSheet. UsedRange. Cellules (1)
Lin = Colonnes (1) .Find ("*", xlPrevious) .Row
Bis :
Tenez = Faux
Pour col = 1 à Rangées (Lin) .Find ("*",
xlPrevious) .Column
Si Cellules (Lin, col) < > Cellules (Lin - 1, col)
tiennent Alors = Vraies
Ensuite col
Si tiennent = Faux Se querelle (Alors Lin) .Delete
Lin = Lin - 1
Si Lin > 1 Alors GoTo bis
Fin Sub
2)
Sub seconde ()
Collec Terne Comme Nouvelle Collection(Ramassage), Cellule
Comme Gamme, Plage Comme Gamme
Sur Résumé d'Erreur Ensuite
Jeu Plage = Demande(Application). InputBox ("Plage à
examinateur", Type : = 8)
Si IsEmpty (Plage) Quitte Alors Sub
Pour Chaque Cellule Dans Plage
Si Cellule. Valeur < > "" Alors
Collec. Ajoutez la Cellule. Valeur, CStr (Cellule.
Valeur)
Si Se trompent < > 0 Alors
Tromper. Clair
Cellule. Intérieur. ColorIndex = 43
Autrement
Cellule. Intérieur. ColorIndex = 6
Fin Si
Fin Si
La cellule Suivante
Fin Sub

en Allemand REVERSO ???

U-Boot-Premier ()
ActiveSheet. UsedRange. EntireRow. Sorte Key1: =
ActiveSheet. UsedRange. Zellen (1)
Lin = Säulen (1) .Find ("*", xlPrevious) .Row
Wiederholung:
halten Sie = Falsch
Für Joch = 1 zu Reihen(Rudern) (Lin) .Find ("*",
xlPrevious) .Column
Wenn Zellen (Lin, Joch) <> Zellen (Lin - 1, Joch) Dann =
Wahr halten
Folgendes Joch
Wenn = Falsch halten, dann Streitet Sich (Lin) .Delete
Lautstark
Lin = Lin - 1
Wenn Lin> 1 Dann GoTo Wiederholung
Endu-Boot

2)
U-Boot-Sekunde ()
Verdunkeln Sie Collec Als Neue Sammlung, Zelle Als Reihe
(Abstand), Plage Als Reihe(Abstand)
Auf Fehlerzusammenfassung Als nächstes
Satz Plage = Anwendung. InputBox (" Plage à Prüfer ",
Typ: = 8)
Wenn IsEmpty (Plage) Dann U-Boot Verläßt
Für Jede Zelle in Plage
Wenn Zelle. Wert <> " " Dann
Collec. Fügen Sie Zelle hinzu. Wert, CStr (Zelle.
Wert)
Wenn Sich <> 0 Dann Irren
Irren. Klar
Zelle. Interieur. ColorIndex = 43
Sonst
Zelle. Interieur. ColorIndex = 6
Ende Wenn
Ende Wenn
Folgende Zelle
Endu-Boot

en ESPAGNOL REVERSO ????

Sub primer ministro ()
ActiveSheet. UsedRange. EntireRow. Clase Key1: =
ActiveSheet. UsedRange. Células (1)
lin = Columnas (1) .Find ("*", xlPrevious) .Row
bis:
guarde(mantenga) = Falso
Para col = 1 a Filas (lin) .Find ("*", xlPrevious) .Column
Si Células (lin, col) <> Células (lin - 1, col) Entonces
guardan(mantienen) = Verdaderas
Después col
Si guardan(mantienen) = Falso Entonces Rema (lin) .Delete
lin = lin - 1
Si lin> 1 Entonces GoTo bis
Final Sub
2)
Sub segundo ()
Collec Débil Como Nueva Colección, Célula Como Gama, Plage
Como Gama
Sobre Curriculum vitae de Error Después
Juego Plage = Uso. InputBox (" Plage à examinador ",
Tipo: = 8)
Si IsEmpty (Plage) Entonces Sale Sub
Para Cada Célula En Plage
Si Célula. Valor <> " " Entonces
Collec. Añada la Célula. Valor, CStr (Célula. Valor)
Si Ierran <> 0 Entonces
Errar. Claro
Célula. Interior. ColorIndex = 43
Además
Célula. Interior. ColorIndex = 6
Final Si
Final Si
Siguiente Célula
Final Sub



-----Message d'origine-----
C'est Modeste qui va être content ;-)))

--
Christian M
-------------------------------
"" a écrit dans le message de
news:

bpd696$pje$
Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2
programmes ?



1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort
Key1:¬tiveSheet.UsedRange.Cells(1)


lin = Columns(1).Find("*", , , , , xlPrevious).Row
encore:
keep = False
For col = 1 To Rows(lin).Find("*", , , , ,
xlPrevious).Column


If Cells(lin, col) <> Cells(lin - 1, col) Then keep =
True


Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As
Range



On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner",
Type:=8)



If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub




.




Avatar
Misange
Bon je me lance dans l'essai pour la seconde

Sub second()
Une minute subaquatique


Dim Collec As New Collection, Cell As Range, Plage As Range
Présentation sur la plage de La nouvelle collection d'entre les

collections de dim

On Error Resume Next
Si vous êtes horrifiés passez votre chemin


Set Plage = Application.InputBox("Plage à examiner", Type:=8)
Choisissez bien la plage, enfilez votre 8 de Dim et hop que les types

défilent


If IsEmpty(Plage) Then Exit Sub
Si la plage est vide ;-( rentrez chez vous, fin de la baignade


For Each Cell In Plage
Pour chaque âme sur la plage


If Cell.Value <> "" Then
Si l'âme ne hausse pas les sourcils

Collec.Add Cell.Value, CStr(Cell.Value)


Ajoutez cette âme à votre collection d'admirateurs de strings
If Err <> 0 Then
Si vous vous avez été trompé(e)

Err.Clear
Effacez l'âme de votre souvenir


Cell.Interior.ColorIndex = 43
blemissez d'horreur


Else
sinon

Cell.Interior.ColorIndex = 6
rosissez de plaisir


End If
Fin de si seulement c'était le temps des vacances


End If
si si les vacances sont finies

Next Cell
Nouvelle âme




End Sub
n'oubliez pas de sortir de l'eau !




Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Avatar
Paul V.
Etant plus moderne et moins poetique, j'ai utilisé mon traducteur SYSTRAN et
voila le résultat :

premier() secondaire
ActiveSheet.UsedRange.EntireRow.Sort
Key1:¬tiveSheet.UsedRange.Cells(1) lin = Columns(1).Find("*",,
, xlPrevious).Row
bis :
subsistance = faux
pour colonne = 1 à Rows(lin).Find("*",,, xlPrevious).Column
si Cells(lin, colonne) < > Cells(lin - 1, subsistance de colonne) puis rectifient
après colonne
si subsistance = puis Rows(lin).Delete faux
lin = lin - 1
si lin > 1 puis bis goTo
Sous-marin D'Extrémité

second() secondaire


Faible Collec En tant que Nouvelle Collection, Cellule Comme Gamme, Plage
Comme Gamme


Sur Le Résumé D'Erreur Après

l'examinateur placer de plage = d'Application.InputBox("Plage à",
Type:=8)


S'IsEmpty(Plage) Sortent Alors Le Sous-marin

Pour Chaque Cellule En Plage

Si Cell.Value < > "" Puis
Collec.Add Cell.Value, CStr(Cell.Value)
Si Errent < > 0 Alors
Err.Clear
Cell.Interior.ColorIndex = 43
autrement
Cell.Interior.ColorIndex = 6
Extrémité Si

Extrémité Si

Après Cellule

Sous-marin D'Extrémité



Finalement c'est assez beau ;-)

A+

Paul V

Misange wrote:
Bon je me lance dans l'essai pour la seconde

Sub second()
Une minute subaquatique


Dim Collec As New Collection, Cell As Range, Plage As Range
Présentation sur la plage de La nouvelle collection d'entre les

collections de dim

On Error Resume Next
Si vous êtes horrifiés passez votre chemin


Set Plage = Application.InputBox("Plage à examiner", Type:=8)
Choisissez bien la plage, enfilez votre 8 de Dim et hop que les types

défilent


If IsEmpty(Plage) Then Exit Sub
Si la plage est vide ;-( rentrez chez vous, fin de la baignade


For Each Cell In Plage
Pour chaque âme sur la plage


If Cell.Value <> "" Then
Si l'âme ne hausse pas les sourcils

Collec.Add Cell.Value, CStr(Cell.Value)


Ajoutez cette âme à votre collection d'admirateurs de strings
If Err <> 0 Then
Si vous vous avez été trompé(e)

Err.Clear
Effacez l'âme de votre souvenir


Cell.Interior.ColorIndex = 43
blemissez d'horreur


Else
sinon

Cell.Interior.ColorIndex = 6
rosissez de plaisir


End If
Fin de si seulement c'était le temps des vacances


End If
si si les vacances sont finies

Next Cell
Nouvelle âme




End Sub
n'oubliez pas de sortir de l'eau !




Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta



Avatar
papou
Dim Collec As New Collection, Cell As Range, Plage As Range
'Dis-moi nouvelle collègue, celle qui va à la plage
On Error Resume Next
'arrêtes-moi si je me trompe
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
'à la plage si tu me le demandes je veux bien examiner ton type
If IsEmpty(Plage) Then Exit Sub
'Mais si tu dis non je partirai tout de suite
For Each Cell In Plage
'et toi celle qui t'étends sur la plage
If Cell.Value <> "" Then
'si tu ne dis rien
Collec.Add Cell.Value, CStr(Cell.Value)
'j' ajouterai ton string à ma collection
If Err <> 0 Then
'et si je ne suis pas un zéro
Err.Clear
'alors je serai clair
Cell.Interior.ColorIndex = 43
'et te badigeonnerai de vert (des algues)
Else
'et sinon
Cell.Interior.ColorIndex = 6
'je te badigeonnerai de l'or (du soleil)
End If
End If
Next Cell
"" a écrit dans le message de
news:bpd696$pje$
Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2 programmes ?

1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort Key1:¬tiveSheet.UsedRange.Cells(1)
lin = Columns(1).Find("*", , , , , xlPrevious).Row
encore:
keep = False
For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner", Type:=8)

If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub



Avatar
Misange
ca dégénère !

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

le 18/11/2003 17:01:
Dim Collec As New Collection, Cell As Range, Plage As Range
'Dis-moi nouvelle collègue, celle qui va à la plage
On Error Resume Next
'arrêtes-moi si je me trompe
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
'à la plage si tu me le demandes je veux bien examiner ton type
If IsEmpty(Plage) Then Exit Sub
'Mais si tu dis non je partirai tout de suite
For Each Cell In Plage
'et toi celle qui t'étends sur la plage
If Cell.Value <> "" Then
'si tu ne dis rien
Collec.Add Cell.Value, CStr(Cell.Value)
'j' ajouterai ton string à ma collection
If Err <> 0 Then
'et si je ne suis pas un zéro
Err.Clear
'alors je serai clair
Cell.Interior.ColorIndex = 43
'et te badigeonnerai de vert (des algues)
Else
'et sinon
Cell.Interior.ColorIndex = 6
'je te badigeonnerai de l'or (du soleil)
End If
End If
Next Cell
"" a écrit dans le message de
news:bpd696$pje$

Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2 programmes ?

1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort Key1:¬tiveSheet.UsedRange.Cells(1)
lin = Columns(1).Find("*", , , , , xlPrevious).Row
encore:
keep = False
For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner", Type:=8)

If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub








Avatar
sabatier
ouhhhhhhhhhhhhhh trop bonne, cette traduction
la misange se doit de mettre cela sur excelabo car thierry, là, a fait
très
fort et on devine à travers les mots traduits comme sa double
personnalité n'a
de cesse de le torture : le broutard parle de l'herbe alors que le père
brossollette est à la recherche de la Vérité...
jps

ru-th wrote:

Bon, je fais le premier !

Sub premier()
1er chant

ActiveSheet.UsedRange.EntireRow.Sort Key1:¬tiveSheet.UsedRange.Cells(1)
Entièrement rose,Le destin de l'herbe usée sera Un comme icelle fut usée

dans l'herbe
encore:
encore

keep = False
Gardes-toi du Faux

For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
Forts, ils étaient Un près de la colonne fine et rose

If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Icelle n'est plus icelle, mais gardait la Vérité

Next col
Derrière l'autre colonne

If keep = False Then Rows(lin).Delete
Gardes-toi du Faux car la rose s'enfuit

lin = lin - 1
loin, loin

If lin > 1 Then GoTo encore
loin et plus encore

End Sub
fin du chant


a+
rural thierry

"" a écrit dans le message de news:
bpd696$pje$
Bonjour,

Vous pouvez me traduire, ligne par ligne ces 2 programmes ?

1)

Sub premier()


ActiveSheet.UsedRange.EntireRow.Sort Key1:¬tiveSheet.UsedRange.Cells(1)
lin = Columns(1).Find("*", , , , , xlPrevious).Row
keep = False
For col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
If Cells(lin, col) <> Cells(lin - 1, col) Then keep = True
Next col
If keep = False Then Rows(lin).Delete
lin = lin - 1
If lin > 1 Then GoTo encore




End Sub




2)



Sub second()


Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next

Set Plage = Application.InputBox("Plage à examiner", Type:=8)

If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage

If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear
Cell.Interior.ColorIndex = 43
Else
Cell.Interior.ColorIndex = 6
End If

End If

Next Cell



End Sub