Supprimer ligne si cellule en MAJUSCULE
Bonjour,
Pourriez-vous m'aider?
Colonne A et B, supprimer la ligne quand la cellule est en majuscule
Colonne C,D,E, Mettre un X quand la cellule est en majuscule
Et enlever la "," en fin de phrase
merci
Bonjour,
une proposition via une macro
edit (ajout pour la suppression de la virgule en fin de phrase)
Sub aargh()
With Sheets("feuil4") '<- à adapter
col = 1
Do While .Cells(1, col) <> ""
dl = .Cells(Rows.Count, col).End(xlUp).Row
a = Cells(1, col).Resize(dl, 1).Value
For i = 2 To dl
If a(i, 1) = UCase(a(i, 1)) Then
If col < 3 Then a(i, 1) = "" Else a(i, 1) = "X"
Else
If Right(a(i, 1), 1) = "," Then a(i, 1) = Left(a(i, 1), Len(a(i, 1)) - 1)
End If
Next i
With .Cells(1, col).Resize(dl, 1)
.Value = a
If col < 3 Then
.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
End If
End With
col = col + 1
Loop
End With
End SubBonjour,
Autre proposition
Sub Supp_Lignes()
Dim i As Long
Application.ScreenUpdating = False
DerLig = Range("A1").CurrentRegion.Rows.Count
For i = DerLig To 2 Step -1
If UCase(Cells(i, "A")) = Cells(i, "A") And UCase(Cells(i, "B")) = Cells(i, "B") Then
Rows(i).Delete
End If
Next i
End SubCdlt
Bonjour le fil, bonjour le forum,
Mais que font les contrôleurs anti-dopage ?!...
Je me suis fait tellement grillé sur ce coup que je suis carbonisé. Désolé si mon code sent un peu le roussi :
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TM() As Variant 'déclare la variable TM (Tableau des Majuscules)
Set O = Worksheets("Feuil4") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = UBound(TV, 1) To 2 Step -1 'boucle inversée sur toutes les lignes I du tableau des valeurs TV (de la dernière ligne à la seconde en remontant)
'si la valeur de la donnée ligne I colonne 1 (ou 2) de TV, convertie en majuscule, est égale à sa propore valeur, supprime la ligne I
If UCase(TV(I, 1)) = TV(I, 1) Or UCase(TV(I, 2)) = TV(I, 2) Then O.Rows(I).Delete
Next I 'prochaine ligne de la boucle
TV = O.Range("A1").CurrentRegion 'redéfinit le tableau des valeurs TV (il y a des lignes en moins...)
ReDim TM(1 To UBound(TV, 1), 1 To UBound(TV, 2)) 'redimensionne le tableau des majuscules TM (mêmes dimensions que TV)
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV
For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
If UCase(TV(I, J)) = TV(I, J) Then 'si la donnée ligne I colonne J de TV, convertie en majuscule, est égale à sa propre valeur
TM(I, J) = "X" 'renvoie "X dans la ligne I colonne J de TM
Else 'sinon
TM(I, J) = TV(I, J) 'renvoie la valeur de TV dans TM
End If 'fin de la condition
Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
'renvoie le tableau TL dans la cellule A1 redimensionnée de l'onglet O
O.Range("A1").Resize(UBound(TV, 1), UBound(TV, 2)).Value = TM
End SubBonjour, Arturo83,ThauThème, h2so4
un grand merci à vous 3
Super sympa
et rapide
BRAVO!
@bientôt
Je viens de m'apercevoir que j'ai oublié une étape , correctif
Sub Supp_Lignes()
Dim i As Long
Application.ScreenUpdating = False
DerLig = Range("A1").CurrentRegion.Rows.Count
For i = DerLig To 2 Step -1
If UCase(Cells(i, "A")) = Cells(i, "A") And UCase(Cells(i, "B")) = Cells(i, "B") Then
Rows(i).Delete
Else
For j = 3 To 5
If UCase(Cells(i, j)) = Cells(i, j) Then Cells(i, j) = "X"
Next j
End If
Next i
End SubBonjour,
Excellent Arturo83, encore une petite modif---> la suppression de la "," en fin de phrase et ce sera PARFAIT!
merci
tu es au TOP
OK, voilà:
Sub Supp_Lignes()
Dim i As Long
Application.ScreenUpdating = False
DerLig = Range("A1").CurrentRegion.Rows.Count
For i = DerLig To 2 Step -1
If UCase(Cells(i, "A")) = Cells(i, "A") And UCase(Cells(i, "B")) = Cells(i, "B") Then
Rows(i).Delete
Else
For j = 3 To 5
If UCase(Cells(i, j)) = Cells(i, j) Then Cells(i, j) = "X"
If Right(Cells(i, j), 1) = "," Then Cells(i, j) = Left(Cells(i, j), Len(Cells(i, j)) - 1)
Next j
End If
Next i
End Sub