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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
-----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
.
-----Message d'origine-----
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
.
-----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
.
-----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
.
-----Message d'origine-----
C'est Modeste qui va être content ;-)))
--
Christian M
-------------------------------
"sonic@view" <sonic@view.com> a écrit dans le message de
news:
bpd696$pje$1@reader1.imaginet.fr...
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
.
-----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
.
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
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
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)
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 !
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
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
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)
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 !
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
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
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)
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 !
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é
Bon je me lance dans l'essai pour la secondeSub 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 dimOn Error Resume Next
Si vous êtes horrifiés passez votre cheminSet Plage = Application.InputBox("Plage à examiner", Type:=8)
Choisissez bien la plage, enfilez votre 8 de Dim et hop que les types
défilentIf 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 sourcilsCollec.Add Cell.Value, CStr(Cell.Value)
Ajoutez cette âme à votre collection d'admirateurs de stringsIf Err <> 0 Then
Si vous vous avez été trompé(e)Err.Clear
Effacez l'âme de votre souvenirCell.Interior.ColorIndex = 43
blemissez d'horreurElse
sinonCell.Interior.ColorIndex = 6
rosissez de plaisirEnd If
Fin de si seulement c'était le temps des vacances
End If
si si les vacances sont finiesNext Cell
Nouvelle âme
End Sub
n'oubliez pas de sortir de l'eau !
Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta
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é
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
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é
Bon je me lance dans l'essai pour la secondeSub 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 dimOn Error Resume Next
Si vous êtes horrifiés passez votre cheminSet Plage = Application.InputBox("Plage à examiner", Type:=8)
Choisissez bien la plage, enfilez votre 8 de Dim et hop que les types
défilentIf 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 sourcilsCollec.Add Cell.Value, CStr(Cell.Value)
Ajoutez cette âme à votre collection d'admirateurs de stringsIf Err <> 0 Then
Si vous vous avez été trompé(e)Err.Clear
Effacez l'âme de votre souvenirCell.Interior.ColorIndex = 43
blemissez d'horreurElse
sinonCell.Interior.ColorIndex = 6
rosissez de plaisirEnd If
Fin de si seulement c'était le temps des vacances
End If
si si les vacances sont finiesNext Cell
Nouvelle âme
End Sub
n'oubliez pas de sortir de l'eau !
Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta
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
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
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
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
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
"sonic@view" <sonic@view.com> a écrit dans le message de
news:bpd696$pje$1@reader1.imaginet.fr...
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
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
Bon, je fais le premier !Sub premier()
1er chantActiveSheet.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'herbeencore:
encorekeep = False
Gardes-toi du FauxFor col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
Forts, ils étaient Un près de la colonne fine et roseIf 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 colonneIf keep = False Then Rows(lin).Delete
Gardes-toi du Faux car la rose s'enfuitlin = lin - 1
loin, loinIf lin > 1 Then GoTo encore
loin et plus encoreEnd 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
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
"sonic@view" <sonic@view.com> a écrit dans le message de news:
bpd696$pje$1@reader1.imaginet.fr...
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
Bon, je fais le premier !Sub premier()
1er chantActiveSheet.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'herbeencore:
encorekeep = False
Gardes-toi du FauxFor col = 1 To Rows(lin).Find("*", , , , , xlPrevious).Column
Forts, ils étaient Un près de la colonne fine et roseIf 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 colonneIf keep = False Then Rows(lin).Delete
Gardes-toi du Faux car la rose s'enfuitlin = lin - 1
loin, loinIf lin > 1 Then GoTo encore
loin et plus encoreEnd 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