Telefonnummer automatisch per VBA formatieren

Bewerten Sie hier bitte das Excel-Portal

Auftragsprogrammierung: Nehmen Sie hier Kontakt auf

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Telefonnummer automatisch per VBA formatieren

Telefonnummer automatisch per VBA formatieren von Lilli vom 26.09.2019 11:47:54

AW: Telefonnummer automatisch per VBA formatieren - von MCO am 26.09.2019 12:54:18

AW: Telefonnummer automatisch per VBA formatieren - von Lilli am 27.09.2019 12:48:08

AW: Telefonnummer automatisch per VBA formatieren - von Dieter Klemke am 26.09.2019 12:57:21

AW: Telefonnummer automatisch per VBA formatieren - von Lilli am 27.09.2019 12:51:56

AW: Telefonnummer automatisch per VBA formatieren - von Dieter Klemke am 28.09.2019 15:31:59

Version Nummer 3 - von Werner am 26.09.2019 13:02:49

AW: Version Nummer 3 - von Lilli am 27.09.2019 12:53:44

leere Versprechungen. o.w.T. - von Werner am 02.10.2019 06:35:53

... und noch eine - von Rudi Maintaire am 26.09.2019 13:35:31

AW: ... und noch eine - von Lilli am 27.09.2019 12:55:27

AW: Telefonnummer automatisch per VBA formatieren - von Daniel am 27.09.2019 14:15:59

Betrifft: Telefonnummer automatisch per VBA formatieren von: Lilli
Geschrieben am: 26.09.2019 11:47:54

Hallo Excel-Fans :)

ich bräuchte bitte Hilfe in Telefonnummer Formatierung.

Für die Rufnummer habe ich folgende Formatierung angewandt: 00 000 0000 0000

das funktioniert auch ganz nett, wenn die Zahl der Rufnummer immer gleich ist.

49 170 1234 1234

wenn die Nummer kürzer ist, sieht das schlecht aus.

Schön wäre, wenn ich die Nummer so eingebe: 4917012341234

dass beim Verlassen der Zelle folgendes erscheint:

+49 170 1234 1234

sollte die Rufnummer kürzer sein, wäre schön, wenn das Makro das erkennt und dementsprechend auch umwandelt.

+49 170 1234 123

Zurzeit habe ich für eine Zelle im Tabellenblatt folgendes Makro drin:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Für Spalte "B3:B4"
If Not Intersect(Target, Range("AC6")) Is Nothing Then
  Application.EnableEvents = False
  Target = UCase(Target)
  Application.EnableEvents = True
End If
End Sub

um die Buchstaben in der Zelle AC6 groß zu machen.
Bei dem Makro wurde mir auch hier geholfen.

Ich hoffe, ich habe alles angegeben, was an Info benötigt wird.

Vielen Dank für die Hilfe im Voraus.

Viele Grüße,
Lilli :)

Betrifft: AW: Telefonnummer automatisch per VBA formatieren von: MCO
Geschrieben am: 26.09.2019 12:54:18

Hallo Lilli!
Probier das mal aus:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim numb As String
    If Target = "" Then Exit Sub
    
    Application.EnableEvents = False
    numb = Replace(Target.Value, "+", "")
    If Len(numb) < 13 Then
        MsgBox "Eingabe zu kurz"
    ElseIf Len(numb) > 13 Then
        MsgBox "Eingabe zu lang"
    Else
        Target.NumberFormat = "+00 000 0000 0000"
    End If
    
    Application.EnableEvents = True
End Sub

Gruß, MCO

Betrifft: AW: Telefonnummer automatisch per VBA formatieren von: Lilli
Geschrieben am: 27.09.2019 12:48:08

Hallo MCO,

vielen Dank für Dein Feedback und für Deine Hilfe.

wo darf ich den Code stellen?
in der Tabelle, wo ich die Funktion brauche, oder in ein extra Modul?

Viele Grüße, Lilli :)

Betrifft: AW: Telefonnummer automatisch per VBA formatieren von: Dieter Klemke
Geschrieben am: 26.09.2019 12:57:21

Hallo Lilli,

ich vermute, dass du die Funktion der bisherigen Worksheet_Change-Prozedur beibehalten willst und dass die Telefonnummern in Spalte B stehen sollen (sonst einfach nur "B" gegen den entsprechenden Buchstaben austauschen).

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rest As String
  Dim zf As String
  
  If Not Intersect(Target, Me.Columns("B")) Is Nothing Then
    Application.EnableEvents = False
    If Target.Cells.Count = 1 Then
      If IsNumeric(Target) Then
        If Len(Target) > 5 Then
          rest = Right$(Target, Len(Target) - 5)
          zf = ""
          Do Until rest = ""
            If Len(rest) > 4 Then
              zf = zf & " " & Left$(rest, 4)
              rest = Right$(rest, Len(rest) - 4)
            Else
             zf = zf & " " & rest
             rest = ""
            End If
          Loop
          Target = "+" & Left$(Target, 2) & " " & Mid$(Target, 3, 3) & " " & zf
        ElseIf Len(Target) > 2 Then
          Target = "+" & Left$(Target, 2) & " " & Right$(Target, Len(Target) - 2)
        Else
          Target = "'+" & Target
        End If
      End If
    End If
    Application.EnableEvents = True
    Exit Sub
  End If
  If Not Intersect(Target, Range("AC6")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
  End If
End Sub

https://www.herber.de/bbs/user/132216.xlsm

Viele Grüße
Dieter

Betrifft: AW: Telefonnummer automatisch per VBA formatieren von: Lilli
Geschrieben am: 27.09.2019 12:51:56

Hallo Dieter,

vielen Dank für Dein Feedback und für Deine Hilfe.

ich möchte es sehr gerne beibehalten. Allerdings brauche ich das nicht für die Spalte B. Das ist im Code auskommentiert. Ich brauche ich es nur für die Zelle AC6. Darf ich fragen was ich ändern soll, wenn ich das nur für die Zelle AC6 brauche?

vielen Dank für Deine Mühe im Voraus.

viele Grüße,
Lilli :)

Betrifft: AW: Telefonnummer automatisch per VBA formatieren von: Dieter Klemke
Geschrieben am: 28.09.2019 15:31:59

Hallo Lilli,

das Programm könnte dann so aussehen:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rest As String
  Dim zf As String
  
  If Target.Address(False, False) = "AC6" Then
    Application.EnableEvents = False
    If Target.Cells.Count = 1 Then
      If IsNumeric(Target) Then
        If Len(Target) > 5 Then
          rest = Right$(Target, Len(Target) - 5)
          zf = ""
          Do Until rest = ""
            If Len(rest) > 4 Then
              zf = zf & " " & Left$(rest, 4)
              rest = Right$(rest, Len(rest) - 4)
            Else
             zf = zf & " " & rest
             rest = ""
            End If
          Loop
          Target = "+" & Left$(Target, 2) & " " & Mid$(Target, 3, 3) & " " & zf
        ElseIf Len(Target) > 2 Then
          Target = "+" & Left$(Target, 2) & " " & Right$(Target, Len(Target) - 2)
        Else
          Target = "'+" & Target
        End If
      End If
    End If
    Application.EnableEvents = True
    Exit Sub
  End If
End Sub

https://www.herber.de/bbs/user/132266.xlsm

Viele Grüße
Dieter

Betrifft: Version Nummer 3 von: Werner
Geschrieben am: 26.09.2019 13:02:49

Hallo Lilli,

meine Version:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TN As String

If Target.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
    If Target <> "" Then
        If IsNumeric(Target) Then
            TN = "+" & Left(Target, 2) & " " & Mid(Target, 3, 3) & " " & Mid(Target, 6, 4) _
            & " " & Mid(Target, 10, 9 ^ 9)
            Application.EnableEvents = False
            Target = TN
            Application.EnableEvents = True
        End If
    End If
End Sub

Gruß Werner

Betrifft: AW: Version Nummer 3 von: Lilli
Geschrieben am: 27.09.2019 12:53:44

Hallo Werner,

vielen Dank für Deine Mühe und für das Feedback.

ich werde es probieren und gebe auf jeden Fall noch Bescheid.

vielen Dank

viele Grüße, Lilli :)

Betrifft: leere Versprechungen. o.w.T. von: Werner
Geschrieben am: 02.10.2019 06:35:53

Betrifft: ... und noch eine von: Rudi Maintaire
Geschrieben am: 26.09.2019 13:35:31

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error GoTo ERREXIT
  Application.EnableEvents = False
  If Target.Count = 1 Then
    Select Case Target.Address(0, 0)
      Case "AC6"
        Target = UCase(Target)
      Case "A6" 'Zelle Telefonnummer; anpassen
        Target = TELNUM(Target)
    End Select
  End If
ERREXIT:
  Application.EnableEvents = True
End Sub

Function TELNUM(vntNum)
  Dim l As Integer
  vntNum = Replace(vntNum, "+", "")
  l = Len(vntNum)
  vntNum = Left(vntNum & String(13, "0"), 13)
  vntNum = Format(--vntNum, "00 000 0000 0000")
  TELNUM = "+" & Left(vntNum, l + Int(l / 3) + (l > 9))
End Function

Gruß
Rudi

Betrifft: AW: ... und noch eine von: Lilli
Geschrieben am: 27.09.2019 12:55:27

Hallo Rudi,

vielen Dank für Deine Version und für Deine Mühe.

ich werde es probieren und werde es auf jeden Fall ein Feedback geben.

Viele Grüße,
Lilli :)

Betrifft: AW: Telefonnummer automatisch per VBA formatieren von: Daniel
Geschrieben am: 27.09.2019 14:15:59

Hi
noch ne andere Möglichkeit, wenn du die Telefonnummer immer als Zahl eingibst:

erstelle für die Spalte über die Bedingte Formatierung für jede möchliche Telefonnummernlänge ein eigenes Zahlenformat mit Formel als Regel in Spalte B:

Regel: =Länge(B1)=13 Zahlenformat: +00 000 0000 0000
Regel: =Länge(B1)=12 Zahlenformat: +00 000 0000 000
usw.

Gruß Daniel