Text in der selben Zelle ergänzen

[d'r Bastler]

Sorry Folks,

leider hatte ich mein Passwort für die OH nicht parat, aber eine Lösung des Themas Ausrichtung von Text innerhalb 1 Zelle Hier der Code für das Blatt:

Code: Alles auswählen

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sText As String, r As Integer, c As Integer
Cancel = True: sText = Target.Text: r = Target.Row: c = Target.Column

If sText <> "" And InStr(sText, "%") = 0 Then   'schließt leere und Zellen mit "%" aus
    Select Case Len(sText)                      'reagiert auf die Länge des Zelltextes
        Case Is < 5
            Cells(r, c) = sText & " 25%"        'überschreibt die Zelle
        Case Is > 10
            Cells(r, c) = sText & " 100%"
        Case Else
            Cells(r, c) = sText & " 75%"
    End Select
End If

End Sub

Hoffe, es hilft