Hajo's Excelzeiten mit einer umfangreiche Beispielsammlung zum kostenfreien Download. 
			Sowohl Formellösungen als auch Beispiele für die Makroprogrammierung in Excel.
Home
VBA Beispiele

  Allgemein
  Bilder einfügen
  blinkender Zellinhalt
  Counter
  Datei schließen
  Dateikopie
  Dateiverwaltung
  Datensätze umschreiben
  Datum / Zeit
  DropDown-Listenfeld
  Drucken
  Ersatz bedingte Formatierung
  Füllfarbe
  Kontextmenü
  Markieren
  nur mit Makros
  Sound
  Stoppuhr
  Symbolleiste Formular
  Symbolleiste vor 2007
  Symbolleiste ab 2007
  UserForm

ohne VBA Beispiele
fremde Dateien
Hinweise zu Excel ab Version 2007
Übersicht Downloads
Bilder
Kontakt
Favoriten
Mein Heim-Forum
Tools Tabelle Forum
Impressum
Copyright
Disclaimer

letzte Bearbeitung 08.11.17

Valid XHTML 1.0 Strict CSS ist valide!
Bing
Suchmaschinenoptimierung mit Ranking-Hits



' **************************************************************
'  Modul:  Tabelle1  Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************

Option Explicit                                     ' Variablendefinition erforderlich

Private Sub Worksheet_Change(ByVal Target As Range)
    '**************************************************
    '* H. Ziplies                                     *
    '* 06.11.12                                       *
    '* erstellt von HajoZiplies@WEB.de                *
    '* http://Hajo-Excel.de/                          *
    '**************************************************
    ' 00 vor jede Eingabe in dem Bereich
    Dim RaBereich As Range                          ' Bereich der Wirksamkeit
    Dim RaZelle As Range                            ' aktuelle Zelle die bearbeitet wird
    ' Variable für NumberFormat, Stellen vor dem Komma+2, Stellen nach dem Komma
    Dim StZahl As String
    ' Fehlerbehandlung, falls doch mal ein Fehler kommt
    ' aus welchen Grunde auch immer, Reaktion auf Eingabe
    ' wieder einschalten
    On Error GoTo Fehler1:                          ' Fehlerbehandlung
    Set RaBereich = Range("B5:C14,E5:E7")           ' Bereich der Wirksamkeit
    ' noch mehr Bereiche
    'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15"), _
    '    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47"), _
    '    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79"), _
    '    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109"), _
    '    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133"), _
    '    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161"), _
    '    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189"))
    ' nur die Zellen prüfen die im überwachten Bereich liegen
    Set RaBereich = Intersect(RaBereich, Range(Target.Address))
    'prüfen ob Zelle im Bereich geändert wurde
    If Not RaBereich Is Nothing Then
        'ActiveSheet.Unprotect "Passwort"           ' Tabellenschutz aufheben
        Application.EnableEvents = False            ' Reaktion auf Eingaben abschalten
        ' eine Schleife falls mehr als eine Zelle mit einmal ausgefüllt wurde
        ' bei einer Zelle wird die Schleife nur einmal durchlaufen
        For Each RaZelle In RaBereich
            If RaZelle <> "" Then                   ' Prüfen ob was in der Zelle steht
                If IsNumeric(RaZelle) Then          ' Prüfen ob Eingabe numerisch
                    ' feststellen wieviele Stellen vor dem Komma und soviele Nullen
                    ' auf die Variable StZahl schreiben Plus die 2 zusätzlichen Nullen
                    StZahl = String(Len(CStr(CLng(RaZelle.Value))) + 2, "0")
                    If InStr(RaZelle, ",") > 0 Then ' Prüfen ob Szellen nach Komma
                        ' Stellen nach dem Komma an StZahl anhängen
                        ' StZahl bildet die Grundlage für das Format
                        StZahl = StZahl & "." & String(Len(RaZelle) - _
                            Len(CStr(CLng(RaZelle))) - 1, "0")
                    End If
                    RaZelle.NumberFormat = StZahl   ' Zelle das neue Format zuweisen
                Else
                    ' Inhalt ist nicht numerisch, 00 nur davor
                    ' es ist keine Veränderung des Format notwendig
                    ' da der Zellinhalt Text ist
                    RaZelle = "00" & RaZelle
                End If
            End If
        Next RaZelle
    End If
Fehler1:
    Set RaBereich = Nothing
    Application.EnableEvents = True                 ' Reaktion auf Eingaben einschalten
    ' ActiveSheet.Protect "Passwort"                ' Tabellenschutz setzen
End Sub

Code eingefügt mit: Excel Code Jeanie, angepasst an XHTML