Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Address = "$H$2:$H$307" Then
Dim H As Variant
End If
For Each H In Range("L2:L307")
If H.Value <> H.Offset(0, -4) Then
H.Offset(0, -4) = H.Value
End If
Next
If Target.Address = "$J$2:$J$307" Then
Dim N As Variant
End If
For Each N In Range("N2:N307")
If N.Value <> N.Offset(0, -4) Then
N.Offset(0, -4) = N.Value
End If
Next
End Sub
Damit werden Zahlen (0-9) automatisch übertragen.
Eigentlich läuft es, aber die 0 wird beim Eintippen sehr oft nicht übertragen, andere Ziffern sind immer fehlerfrei.
Ich gebe in der Spalte H eine Zahl, z.B. 3 ein, dann wird diese Zahl in die Spalte L übertragen.
Dann gebe ich in der Spalte J eine Zahl ein, z.B. 2, dann wird diese Zahl in die Spalte N übertragen.
In den Spalten L und N existiert eine Funktion (Sverweis). Gibt es dadurch Probleme?
Kann man die Prozedur evtl. umschreiben, so dass sie stabiler wird und dieser Fehler nicht auftritt?
Hilfe wäre nett.
Schönen Gruß
Burghard
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range ' überträgt Änderungen von Sp.H in Sp.L und von Sp.J in Sp.N
If Not Intersect(Target, Range("H2:H307,J2:J307")) Is Nothing Then
Application.EnableEvents = False
For Each rng In Intersect(Target, Range("H2:H307,J2:J307"))
If rng.Offset(0, 4).Text <> rng.Text Then rng.Offset(0, 4) = rng
Next rng
Application.EnableEvents = True
End If
End Sub
Bevor du das testest, solltest du die Worksheet_SelectionChange-Prozedur stilllegen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range ' überträgt Änderungen von Sp.H in Sp.L und von Sp.J in Sp.N
If Not Intersect(Target, Range("H2:H307,J2:J307")) Is Nothing Then
Application.EnableEvents = False
For Each rng In ThisWorkbook.ActiveSheet.Range("L2:L307")
If rng.Offset(0, -4).Value <> rng.Value Then rng.Offset(0, -4).Value = rng.Value
Next rng
For Each rng In ThisWorkbook.ActiveSheet.Range("N2:N307")
If rng.Offset(0, -4).Value <> rng.Value Then rng.Offset(0, -4).Value = rng.Value
Next rng
Application.EnableEvents = True
End If
End Sub
Das löst zwar noch nicht Dein Problem mit dem Autofilter, aber das andere Problem sollte es beheben.
Viele Grüße
Björn
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range ' kopiert Änderungen in Sp.H und J in die Zeile mit gleicher Nr.
If Intersect(Target, Range("H2:H307,J2:J307")) Is Nothing Then Exit Sub
Set rng = Columns(2).Find(What:=Cells(Target.Row, 2), _
After:=Cells(Target.Row, 2), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If rng.Row = Target.Row Then
MsgBox "Spielpaarung " & Cells(Target.Row, 2) & " gibts nur einmal"
Else
Application.EnableEvents = False
Cells(rng.Row, Target.Column) = Target.Value
Application.EnableEvents = True
End If
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Worksheets("Auswertung").Unprotect
If Target.Address = "$H$2:$H$307" Then
Dim H As Variant
End If
For Each H In Range("L2:L307")
If H.Offset(0, -4) <> H.Value Then
H.Offset(0, -4) = H.Value + 0.1
End If
Next
If Target.Address = "$J$2:$J$307" Then
Dim N As Variant
End If
For Each N In Range("N2:N307")
If N.Offset(0, -4) <> N.Value Then
N.Offset(0, -4) = N.Value + 0.1
End If
Next
End Sub
Das Filterproblem konnte ich lösen. Ich habe in der Spalte K mit dem "Autofilter" über "benutzerdefiniert" den Filter auf kleiner als 154 gesetzt. Dann werden die Datensätze richtig gefiltert.
Erich, ich denke, wir sollten den Thread beenden, wenn Du meinst, dass die o.g. Änderung in meiner Programmierung nicht machbar ist ohne eine Fehlermeldung (Anhängen des Wertes 0,1).
Ich danke Dir für Deine Geduld und Ausdauer!
Schönen Gruß
Burghard
Set rng = Columns(2).Find(What:=Cells(Target.Row, 2), _
After:=Cells(Target.Row, 2), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
Ein Laufzeitfehler 91 - "Objektvariable oder With-Blockvariable nicht festgelegt"
in Zeile "If rng.Row = Target.Row Then" tritt auf, wenn Spalte 2 (B) ausgeblendet ist.
Wenn du Spalte B einblendest, funzt die Prozedur.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range ' kopiert Änderungen in Sp.H und J in die Zeile mit gleicher Nr.
If Intersect(Target, Range("H2:H307,J2:J307")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Columns(2).Hidden = False
Set rng = Columns(2).Find(What:=Cells(Target.Row, 2), _
After:=Cells(Target.Row, 2), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If rng.Row = Target.Row Then
MsgBox "Spielpaarung " & Cells(Target.Row, 2) & " gibts nur einmal"
Else
Application.EnableEvents = False
Cells(rng.Row, Target.Column) = Target.Value
Application.EnableEvents = True
End If
Columns(2).Hidden = True
Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Address = "$H$2:$H$307" Then
Dim H As Variant
End If
For Each H In Range("L2:L307")
If H.Offset(0, -4) <> H.Value Then
H.Offset(0, -4) = H.Value
End If
Next
If Target.Address = "$J$2:$J$307" Then
Dim N As Variant
End If
For Each N In Range("N2:N307")
If N.Offset(0, -4) <> N.Value Then
N.Offset(0, -4) = N.Value
End If
Next
End Sub
Beispiel:
Gebe ich in H 14 die 2 ein, dann erscheint in H31 und L14 und L31 auch die 2.
Gebe ich in J 14 die 1 ein, dann erscheint in J31 und L31 und N31 auch die 2.
Alles wie gewünscht.
Wenn ich die 2 und die 1 mit einer 0 überschreiben, geht auch alles.
Lösche ich aber in H14 und in J14 die Zahlen und trage danach eine 0 in H14 und in J14 ein, dann erscheint weder in H31 noch in J31 die 0.
Wenn ich aber nach der Löschung der Zahlen in H14 und J14 anschließend in H14 und in J14 den Wert 0,1 eintrage, läuft alles wieder. Irgendwie hat Excel ein Problem mit der Zahl, dem Wert 0.
Idee:
Kann ich zu dem Wert der eingetragen wird, automatisch 0,1 addieren? Dann würde alles laufen. Angezeigt wird nur der Ganzwert. Das reicht mir.
Ich habe einmal die Programmierung geändert. Das führt aber bei einer zweiten Veränderung der Zelle (Löschen, Anklicken) zu einer Fehlermeldung. Könnte man die umgehen?
Beispiel für eine gedachte Änderung:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Address = "$H$2:$H$307" Then
Dim H As Variant
End If
For Each H In Range("L2:L307")
If H.Offset(0, -4) <> H.Value Then
H.Offset(0, -4) = H.Value + 0.1
End If
Next
If Target.Address = "$J$2:$J$307" Then
Dim N As Variant
End If
For Each N In Range("N2:N307")
If N.Offset(0, -4) <> N.Value Then
N.Offset(0, -4) = N.Value + 0.1
End If
Next
End Sub
Ich hoffe, ich nerve Dich nicht zu sehr.
Die Sache mit dem Filtern oder Ausblenden, muss ich mir noch einmal gründlich anschauen. Vielen Dank für Deine Vorschläge.
Wenn die Änderung der o.g. Prozedur (addieren von 0,1 ohne Fehlermeldung nicht geht) sollte man m.E. den Thread beenden.
Vielen Dank für alle Deine Bemühungen!
Schönen Gruß
Burghard