Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zweites Wort in einer Zelle in GROSSBUCHSTABEN

Zweites Wort in einer Zelle in GROSSBUCHSTABEN
07.09.2018 11:36:04
Michael
Hallo zusammen,
ich benötige ein Makro welches in einer Zelle das zweite Wort immer in Grossbuchstaben ausgibt. Es soll Vorname NACHNAME ausgegeben werden.
Quasi das Wort nach dem Leerzeichen in GROSS. Hat hier jemand etwas für mich? :)

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zweites Wort in einer Zelle in GROSSBUCHSTABEN
07.09.2018 11:52:55
UweD
Hallo
in ein Modul
Sub GROSSbuchstaben()
    Dim i As Long, Sp As Integer, z1 As Integer, LR As Long, TB, Pos As Integer
    
    Set TB = Sheets("Tabelle1")
    Sp = 1 'Spalte A 
    
    z1 = 1 'ggf wegen Überschrift 
    
    LR = TB.Cells(TB.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte 
    
    For i = z1 To LR
        Pos = InStr(TB.Cells(i, Sp), " ")
        If Pos > 0 Then
            TB.Cells(i, Sp + 1) = Left(TB.Cells(i, Sp), Pos) & UCase(Mid(TB.Cells(i, Sp), Pos + 1))
        End If
    Next
End Sub

LG UweD
Anzeige
AW: Zweites Wort in einer Zelle in GROSSBUCHSTABEN
07.09.2018 11:53:03
Rudi
Hallo,
als Anrgung
Function KleinGROSS(DerText As String)
Dim tmp
tmp = Split(DerText, " ")
tmp(0) = WorksheetFunction.Proper(tmp(0))
tmp(1) = UCase(tmp(1))
KleinGROSS = Join(tmp, " ")
End Function
Gruß
Rudi
AW: Zweites Wort in einer Zelle in GROSSBUCHSTABEN
07.09.2018 11:57:55
EtoPHG
Hallo Michael,
....und wieso ein Makro?
1. würde ich solche Zellinhalte mit Text-in-Spalten aufteilen das erleichert solche Aufgaben ungemein.
2. und sonst halt mit Formelkonstrukten wie =LINKS(A1;FINDEN(" ";A1))&GROSS(RECHTS(A1;LÄNGE(A1)-FINDEN(" ";A1)))
3. und die Formelergebnisse ggf. als Inhalte über die Ursprungszellen kopieren.
Gruess Hansueli
Anzeige
AW: Zweites Wort in einer Zelle in GROSSBUCHSTABEN
07.09.2018 12:19:07
Michael
Danke UweD funktioniert prima. Man muss es jedoch immer anstoßen das Script, schön wäre es wenn es bereits bei / nach der Eingabe automatisch geschieht.
@Rudi Maintaire: Danke aber da ich null Kenntnisse in VBA besitze bringt mir die Anregung leider auch nichts. :)
@EtoPHG: Die Namen werden Copy&Paste eingefügt, darum in einer Zelle. Ansatz gefällt mir sehr gut, nur hat deine Formel bei mir jetzt nicht funktioniert.
Was hat nicht funktioniert?
07.09.2018 12:54:54
EtoPHG

AW: Was hat nicht funktioniert?
07.09.2018 12:58:17
UweD
Hallo
automatisch beim Zellen ändern...
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- dieses Makro dort reinkopieren
Microsoft Excel Objekt Tabelle1
Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
    On Error GoTo Fehler 
    Dim RNG As Range, Z, Pos As Integer 
     
    Set RNG = Columns("A") 
    If Not Intersect(RNG, Target) Is Nothing Then 
        For Each Z In Intersect(RNG, Target) 
            Pos = InStr(Z.Value, " ") 
            If Pos > 0 Then 
                Application.EnableEvents = False 
                Z.Value = Left(Z.Value, Pos) & UCase(Mid(Z.Value, Pos + 1)) 
            End If 
        Next 
    End If 
Fehler: 
    Application.EnableEvents = True 
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear 
End Sub 

LG uweD
Anzeige
AW: Was hat nicht funktioniert?
07.09.2018 13:10:17
Michael
@EtoPHG: Hab in Zeile A1 einen Vor- und Nachnamen geschrieben und versucht deine Formel 1:1 einzusetzten. Es wird dann "0" ausgegeben.
@UweD: Klappt leider nicht, Fehler im Makro. https://www.herber.de/bbs/user/123825.xlsm
AW: Was hat nicht funktioniert?
07.09.2018 13:24:25
UweD
Hi
du hast die Fehlerbehandlung 2x drin
nach dem ersten End Sub löschen
Userbild
LG UweD
AW: Was hat nicht funktioniert?
07.09.2018 13:50:23
Michael
Läuft trotzdem nicht.
Userbild
Anzeige
AW: Was hat nicht funktioniert?
07.09.2018 14:04:46
UweD
Option Explicit muss ganz oben stehen.
schmeiss alles raus und kopiere nur das hier in den Codebereich der Tabelle
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehler
    Dim RNG As Range, Z, Pos As Integer
     
    Set RNG = Columns("A:D") 'der Bereich, in dem Änderungen abgearbeitet werden sollen / hier A:D 
    
    If Not Intersect(RNG, Target) Is Nothing Then
        For Each Z In Intersect(RNG, Target)
            Pos = InStr(Z.Value, " ")
            If Pos > 0 Then
                Application.EnableEvents = False
                Z.Value = Left(Z.Value, Pos) & UCase(Mid(Z.Value, Pos + 1))
            End If
        Next
    End If
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: Was hat nicht funktioniert?
07.09.2018 14:10:19
Michael
Perfekt @UweD ... vielen Dank. :)
@EtoPHG: Ich habe ein deutsches Excel. ;) Aber danke für deine Hilfe, hat sich jetzt eh erledigt. Schönes Wochenende euch.
Formel funktioniert...in deutschem Excel! (owT)
07.09.2018 14:08:06
EtoPHG

371 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige