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
 

Fichiers joints

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.
 

Fichiers joints

Discussions similaires


Haut Bas