Worksheet-Change zweimal

Bild

Betrifft: Worksheet-Change zweimal
von: Gisela
Geschrieben am: 05.04.2005 12:17:55
Hallo,
wie kann ich die beiden Worksheet-Change Ereignisse zu einem zusammenfassen?
Da ich nur Recorder-Kenntnisse habe, stehe ich ratlos vor dem Problem, dass nur ein Ereignis möglich ist.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%
'Soll nur bei einer Eingabe in Spalte F und G wirksam werden:
If Target.Column <> 6 And Target.Column <> 7 Then Exit Sub
With Cells(Target.Row, Target.Column)
    If .Value = "" Then Exit Sub
    If IsNumeric(.Value) And InStr(.Value, ":") = 0 And _
        InStr(.Value, ",") = 0 Then
        .NumberFormat = "[hh]:mm"
        If Len(.Value) > 2 Then
            s = Left(.Value, Len(.Value) - 2)
            m = Right(.Value, 2)
        Else
            s = .Value
            m = 0
        End If
        .Value = s & ":" & m
    End If
End With
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim a, t, m, j, ZielBereich As Range
    If Target.Count > 1 Then Exit Sub
    Set ZielBereich = Application.Intersect(Range("D:E"), Target)
    If ZielBereich Is Nothing Then Exit Sub
    a = Target.Value
    If IsNumeric(a) = False Then Exit Sub
    If a < 10000 Or a > 999999 Then Exit Sub
    a = Format(a, "000000")
    t = Mid$(a, 1, 2)
    m = Mid$(a, 3, 2)
    j = Mid$(a, 5, 2)
    a = DateSerial(j, m, t)
    Application.EnableEvents = False
        Target.Value = a
        Target.NumberFormat = "dd.mm.yy"
    Application.EnableEvents = True
End Sub

Vielen Dank für die Hilfe
Grüße
Gisela
Bild

Betrifft: AW: Worksheet-Change zweimal
von: Uduuh
Geschrieben am: 05.04.2005 12:26:57
Hallo,
ungetestet, sollte aber gehen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%, a, t, m, j
Select Case Target.Column
  Case 4, 5
    If Target.Count > 1 Then Exit Sub
    a = Target.Value
    If IsNumeric(a) = False Then Exit Sub
    If a < 10000 Or a > 999999 Then Exit Sub
    a = Format(a, "000000")
    t = Mid$(a, 1, 2)
    m = Mid$(a, 3, 2)
    j = Mid$(a, 5, 2)
    a = DateSerial(j, m, t)
    Application.EnableEvents = False
        Target.Value = a
        Target.NumberFormat = "dd.mm.yy"
    Application.EnableEvents = True
  Case 6, 7
    With Cells(Target.Row, Target.Column)
        If .Value = "" Then Exit Sub
        If IsNumeric(.Value) And InStr(.Value, ":") = 0 And _
            InStr(.Value, ",") = 0 Then
            .NumberFormat = "[hh]:mm"
            If Len(.Value) > 2 Then
                s = Left(.Value, Len(.Value) - 2)
                m = Right(.Value, 2)
            Else
                s = .Value
                m = 0
            End If
            .Value = s & ":" & m
        End If
    End With
End Select
End Sub

Gruß aus'm Pott
Udo

Gruß
Bild

Betrifft: AW: Worksheet-Change zweimal
von: P@ulchen
Geschrieben am: 05.04.2005 12:31:39
Hi Udo,
läuft, wenn Du die doppelte Variablendeklaration (m) rausnimmst...
Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !
Bild

Betrifft: Uhps oT
von: Uduuh
Geschrieben am: 05.04.2005 13:02:42

Bild

Betrifft: AW: Worksheet-Change zweimal
von: P@ulchen
Geschrieben am: 05.04.2005 12:27:58
Hallo Gisela,
versuch mal so (ungetestet):


Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%
Dim a, t, j, ZielBereich As Range
If Target.Count > 1 Then Exit Sub
'Soll nur bei einer Eingabe in Spalte F und G wirksam werden:
If Target.Column > 5 And Target.Column < 8 Then
    With Cells(Target.Row, Target.Column)
        If .Value = "" Then Exit Sub
        If IsNumeric(.Value) And InStr(.Value, ":") = 0 And InStr(.Value, ",") = 0 Then
            .NumberFormat = "[hh]:mm"
            If Len(.Value) > 2 Then
                s = Left(.Value, Len(.Value) - 2)
                m = Right(.Value, 2)
            Else
                s = .Value
                m = 0
            End If
            .Value = s & ":" & m
        End If
    End With
End If
Set ZielBereich = Application.Intersect(Range("D:E"), Target)
If ZielBereich Is Nothing Then Exit Sub
a = Target.Value
If IsNumeric(a) = False Then Exit Sub
If a < 10000 Or a > 999999 Then Exit Sub
a = Format(a, "000000")
t = Mid$(a, 1, 2)
m = Mid$(a, 3, 2)
j = Mid$(a, 5, 2)
a = DateSerial(j, m, t)
Application.EnableEvents = False
Target.Value = a
Target.NumberFormat = "dd.mm.yy"
Application.EnableEvents = True
End Sub

     Code eingefügt mit Syntaxhighlighter 2.1

Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !
Bild

Betrifft: AW: Worksheet-Change zweimal
von: Gisela
Geschrieben am: 05.04.2005 13:23:37
Hallo
vielen Dank an beide für die Mühe.
Liebe Grüße
Gisela
Bild

Betrifft: AW: Nochmal Hilfe
von: Gisela
Geschrieben am: 05.04.2005 13:41:07
Hallo,
es gibt ein Problem, dass sich wie folgt darstellt.
Wenn ich in der Spalte D mehrer Datenumseingaben mache, ist die Ansicht:
020205 = 02.02.05 ist ok, bei der gleichen Eingabe in der nächsten Zeile dann 020205 =26.04.55
Kann mir bitte nochmal jemand helfen und sagen owran das liegt.
Grüße
Gisela
Bild

Betrifft: AW: Nochmal Hilfe
von: P@ulchen
Geschrieben am: 05.04.2005 14:20:10
Hallo Gisela,
habe am Ende des Codes mal die Zeile mit dem NumberFormat ersetzt:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%
Dim a, t, j, ZielBereich As Range
If Target.Count > 1 Then Exit Sub
'Soll nur bei einer Eingabe in Spalte F und G wirksam werden:
If Target.Column > 5 And Target.Column < 8 Then
    With Cells(Target.Row, Target.Column)
        If .Value = "" Then Exit Sub
        If IsNumeric(.Value) And InStr(.Value, ":") = 0 And InStr(.Value, ",") = 0 Then
            .NumberFormat = "[hh]:mm"
            If Len(.Value) > 2 Then
                s = Left(.Value, Len(.Value) - 2)
                m = Right(.Value, 2)
            Else
                s = .Value
                m = 0
            End If
            .Value = s & ":" & m
        End If
    End With
End If
Set ZielBereich = Application.Intersect(Range("D:E"), Target)
If ZielBereich Is Nothing Then Exit Sub
a = Target.Value
If IsNumeric(a) = False Then Exit Sub
If a < 10100 Or a > 999999 Then Exit Sub
a = Format(a, "000000")
t = Mid(a, 1, 2)
m = Mid(a, 3, 2)
j = Mid(a, 5, 2)
a = DateSerial(j, m, t)
Application.EnableEvents = False
Target.Value = Format(a, "dd.mm.yy")
'Target.NumberFormat = "dd.mm.yy"
Application.EnableEvents = True
End Sub

     Code eingefügt mit Syntaxhighlighter 2.1

Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !
Bild

Betrifft: AW: Nochmal Hilfe
von: Gisela
Geschrieben am: 05.04.2005 15:25:34
Hallo Paulchen,
vielen Dank, dass Du Dich meines Problems nochmal erbarmt hast.
es ist jetzt etwas besser. Aber eine stabile eingabe ist immer noch nicht möglich.z.B.
wird 130205 nicht immer 13.02.05. Die Eingabe 13.02.2005 führt zu einem Fehler. Wenn ich 130205 eingebe, steht 13.02.05 links. Bei Eingabe von 13.02.05 steht der Eintrag rechts. Ich weiss, dass das letztere mit der Formatierung (Standard oder Datum) zu tun hat.
Kann man daran etwas ändern?
Liebe Grüße
Gisela
Bild

Betrifft: AW: Nochmal Hilfe
von: P@ulchen
Geschrieben am: 05.04.2005 15:36:29
Hallo Gisela,
probier mal so:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%
Dim a, t, j, ZielBereich As Range
If Target.Count > 1 Then Exit Sub
'Soll nur bei einer Eingabe in Spalte F und G wirksam werden:
If Target.Column > 5 And Target.Column < 8 Then
    With Cells(Target.Row, Target.Column)
        If .Value = "" Then Exit Sub
        If IsNumeric(.Value) And InStr(.Value, ":") = 0 And InStr(.Value, ",") = 0 Then
            .NumberFormat = "[hh]:mm"
            If Len(.Value) > 2 Then
                s = Left(.Value, Len(.Value) - 2)
                m = Right(.Value, 2)
            Else
                s = .Value
                m = 0
            End If
            .Value = s & ":" & m
        End If
    End With
End If
Set ZielBereich = Application.Intersect(Range("D:E"), Target)
If ZielBereich Is Nothing Then Exit Sub
a = Target.Value
If IsDate(a) = True Then
    Application.EnableEvents = False
    Target.Value = Format(a, "dd.mm.yy")
    Application.EnableEvents = True
    Exit Sub
End If
If IsNumeric(a) = False Then Exit Sub
If a < 10100 Or a > 999999 Then Exit Sub
a = Format(a, "000000")
t = Mid(a, 1, 2)
m = Mid(a, 3, 2)
j = Mid(a, 5, 2)
a = DateSerial(j, m, t)
Application.EnableEvents = False
Target.Value = Format(a, "dd.mm.yy")
Application.EnableEvents = True
End Sub

     Code eingefügt mit Syntaxhighlighter 2.1

Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !
Bild

Betrifft: AW: Nochmal Hilfe
von: Gisela
Geschrieben am: 05.04.2005 15:58:11
Hallo Paulchen,
vielen herzlichen Dank, funktioniert super. Habe jetzt mal alle Möglichkeiten ausprobiert.
Liebe Grüße
Gisela
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Teil einer Zelle auslesen"