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"