Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1552to1556
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Format Sozialversicherungsnummer mit Leerzeichen

Format Sozialversicherungsnummer mit Leerzeichen
27.04.2017 14:49:59
Jürgen
Hallo Excel-Forum,
ich habe ein kleines Formatierungsproblem.
Ich glaube das dies, wenn überhaupt möglich, nur unter VBA gelöst werden kann.
Mit dem Benutzerdefinierten Zahlenformat komme ich nicht weiter da es sich um Zahlen und Buchstaben handelt.
Im Prinzip mochte ich nichts anderes als die Sozialversicherungsnummer mit Leerzeichen darstellen.
Ich habe eine Tabelle "Grunddaten" in der in Spalte B die Nummer eingetragen wird.
Beispiel:
Eingetragen wird sie ohne Leerzeichen:
80121255B807
Ist es möglich, dass nach der Eingabe (mit Return) die Nummer sich wie folgt formatiert:
80 121255 B 807
Das soll nur in dieser Tabelle, bei der Spalte passieren.
Würde mich über jede Hilfe freuen.
Ich danke sehr im Voraus.
Grüße
Jürgen

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

Betreff
Datum
Anwender
Anzeige
AW: Format Sozialversicherungsnummer mit Leerzeichen
27.04.2017 14:59:09
yummi
Hallo Jürgen,

=VERKETTEN(LINKS(B1;2);" ";TEIL(B1;3;6);" ";TEIL(B1;9;1);" ";RECHTS(B1; 3))
wen dein Wert in B1 steht
Gruß
yummi
AW: Format Sozialversicherungsnummer mit Leerzeichen
27.04.2017 15:12:06
Jürgen
Hallo yummi,
vielen Danke für die Antwort.
Allerdings möchte ich vermeiden mit einer zweiten Zelle zu arbeiten.
Wenn möglich sollte sich die Nummer direkt mit Return (in der Zelle in der sie auch eingegeben wurde) formatieren.
Ist das möglich?
Grüße Jürgen
AW: Format Sozialversicherungsnummer mit Leerzeichen
27.04.2017 15:30:17
Jürgen
Sorry hatte vergessen die Frage noch auf offen zu stellen:
Hallo yummi,
vielen Danke für die Antwort.
Allerdings möchte ich vermeiden mit einer zweiten Zelle zu arbeiten.
Wenn möglich sollte sich die Nummer direkt mit Return (in der Zelle in der sie auch eingegeben wurde) formatieren.
Ist das möglich?
Grüße Jürgen
Anzeige
Hier in VBA
27.04.2017 15:37:28
Max2
Hallo,
hier in VBA:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim newNumber As String
Dim i As Long
On Error Resume Next
If Target.Column = 2 Then
i = Len(Target.Value)
If i = 12 Then
newNumber = change_number(Target.Value)
Application.EnableEvents = False
Target.Value = newNumber
Application.EnableEvents = True
End If
End If
End Sub
Function change_number(ByVal number As String) As String
Dim i As Long
Dim newNumber As String
On Error Resume Next
i = Len(number)
newNumber = Left(number, 2) '80
newNumber = newNumber & " " & Mid(number, i - 4, 6) '121255
newNumber = newNumber & " " & Mid(number, i - 3, 1) 'B
newNumber = newNumber & " " & Right(number, 3) '807
change_number = newNumber
End Function

Anzeige
AW: Hier in VBA
27.04.2017 15:47:04
Jürgen
Hallo Max2,
vielen Dank für den VBA-Script.
Ich komme erst morgen dazu diesen zu testen.
Melde mich sofort morgen Früh.
Vielen Dank erst mal.
Grüße Jürgen
AW: Hier in VBA
27.04.2017 15:50:31
Jürgen
Konnte gerade doch noch testen.
Funktioniert toll.
Ich danke dir sehr.
Danke und Beste Grüße
Jürgen
Danke für Rückmeldung. Geschlossen...owT
27.04.2017 23:57:08
Max2

Das dürfte noch etwas zu früh sein,...
28.04.2017 08:25:54
Case
Hallo Max, :-)
... um das Thema zu beenden. ;-)
In Deiner Funktion ist ein Fehler drin.
newNumber = newNumber & " " & Mid(number, i - 4, 6)
Das ergibt mit der Beispielnummer "80121255B807" das hier - "5B807". ;-)
Da musst Du noch anpassen.
Als Alternative mit Regulären Ausdrücken würde es so gehen: ;-)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objMatch As Object
Dim objReg As Object
Dim lngCount As Long
Dim strTMP As String
On Error GoTo Fin
If Target.Column = 2 And Target.CountLarge = 1 Then
Application.EnableEvents = False
If Len(Target.Value) = 12 Then
Set objReg = CreateObject("VbScript.RegExp")
objReg.Pattern = "^(\d{2})(\d{6})(\w)(.+)"
Set objMatch = objReg.Execute(Target.Text)
With objMatch
If .Count > 0 Then
For lngCount = 0 To .Item(0).SubMatches.Count - 1
strTMP = strTMP & .Item(0).SubMatches(lngCount) & " "
Next lngCount
Target.Value = Left(strTMP, Len(strTMP) - 1)
End If
End With
End If
End If
Fin:
Set objMatch = Nothing
Set objReg = Nothing
Application.EnableEvents = True
If Err.number  0 Then MsgBox "Fehler: " & _
Err.number & " " & Err.Description
End Sub
Servus
Case

Anzeige
AW: Das dürfte noch etwas zu früh sein,...
28.04.2017 08:35:50
Jürgen
Guten Morgen Max, Guten Morgen Case,
das hatte ich schon angepasst ;-)
Vielen Dank für den Hinweis.
Aber ich hätte hier doch noch ein kleines Problem.
Im Vorfeld hatte ich in dieser Spalte eine Gültigkeitsprüfung hinterlegt, die vermeiden soll, dass zweimal eine gleiche Nummer eingegeben wird. Diese sieht so aus:
=ZÄHLENWENN($B:$B;B2)=1
Durch das Makro wird diese Prüfung umgangen. Kann man diese vielleicht mit einbauen?
Könntet ihr mir hier nochmal helfen?
Grüße Jürgen
Bezogen auf mein Beispiel...
28.04.2017 09:02:16
Case
Hallo Jürgen, :-)
... würde das so gehen: ;-)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objMatch As Object
Dim objReg As Object
Dim lngCount As Long
Dim strTMP As String
On Error GoTo Fin
If Target.Column = 2 And Target.CountLarge = 1 Then
Application.EnableEvents = False
If Len(Target.Value) = 12 Then
Set objReg = CreateObject("VbScript.RegExp")
objReg.Pattern = "^(\d{2})(\d{6})(\w)(.+)"
Set objMatch = objReg.Execute(Target.Text)
With objMatch
If .Count > 0 Then
For lngCount = 0 To .Item(0).SubMatches.Count - 1
strTMP = strTMP & .Item(0).SubMatches(lngCount) & " "
Next lngCount
Target.Value = Left(strTMP, Len(strTMP) - 1)
End If
End With
End If
If Not Application.WorksheetFunction.CountIf _
(Columns(2), Target.Value) > 1 Then
Else
Target.ClearContents
MsgBox "Doppelt - wurde gelöscht!"
End If
End If
Fin:
Set objMatch = Nothing
Set objReg = Nothing
Application.EnableEvents = True
If Err.number  0 Then MsgBox "Fehler: " & _
Err.number & " " & Err.Description
End Sub
Servus
Case

Anzeige
Vielen Dank
28.04.2017 09:55:36
Jürgen
Klappt klasse.
Hat einen Moment gedauert bis ich mich durchgefuchst habe.
Nochmals vielen Dank Case und auch an Max.
Ein schönes langes Wochenende.
Jürgen
Also das mit...
28.04.2017 10:08:54
Case
Hallo Jürgen, :-)
... dem...
If Not Application.WorksheetFunction.CountIf...
... geht natürlich ohne "Else". Hatte das nur aus einem anderen Code schnell reinkopiert. ;-)
Dir auch ein schönes langes Wochenende. \O/
Servus
Case

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige