XL 2010 Majuscule & espace avec critère (Résolu)

Kael_88

XLDnaute Occasionnel
Le Forum,

Mon problème se situe sur la forme de mon écriture dans la cellule de la Colonne D après validation,

Problème 1 :
Il faudrait qu'il transforme l'écriture de la cellule en Majuscule.

Problème 2:
Entre le premier caractère et le reste des donnée, il me faudrait un espace sauf si la donnée commence par "DEVIS", l'espace n'est plus après le premier caractère mais après le mot "DEVIS"

PS: Le tout doit se faire par macro (pas de formule et pas de MFC)
Merci

Cordialement
 

Pièces jointes

  • Maj & Esp.xlsm
    16 KB · Affichages: 9
Dernière édition:

job75

XLDnaute Barbatruc
Bonsoir Kael_88,

Fichier joint avec la macro Worksheet_Change complétée :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, tablo, i&, x$
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False
If Target.Column = 1 And Target.Count = 1 Then
    If Cells(Target.Row, 1) <> "" Then Cells(Target.Row, 3) = Date
    If Time >= "05" Then Cells(Target.Row, 3).Interior.ColorIndex = 33
    If Time >= "13" Then Cells(Target.Row, 3).Interior.ColorIndex = 4
    If Time >= "21" Or Time < "05" Then Cells(Target.Row, 3).Interior.ColorIndex = 6
    If Target = "" Then Cells(Target.Row, 3).ClearContents: Cells(Target.Row, 3).Interior.ColorIndex = xlNone
End If
Set r = Intersect(Target, Range("D2:D" & Rows.Count), UsedRange)
If Not r Is Nothing Then
    For Each r In r.Areas 'si entrées multiples (copier-coller)
        tablo = r.Resize(, 2) 'matrice plus rapide, au moins 2 éléments
        For i = 1 To UBound(tablo)
            x = UCase(Replace(tablo(i, 1), " ", ""))
            If Left(x, 5) = "DEVIS" Then
                tablo(i, 1) = "DEVIS " & Mid(x, 6)
            ElseIf x <> "" Then
                tablo(i, 1) = Left(x, 1) & " " & Mid(x, 2)
            End If
        Next i
        r = tablo 'restitution
    Next r
End If
Application.EnableEvents = True
End Sub
Bonne nuit.
 

Pièces jointes

  • Maj & Esp(1).xlsm
    24.5 KB · Affichages: 9

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof