Ereignis zeitweise mit Fehler

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

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

Hallo Burghard,
nach wie vor halte ich es für überflüssig, für das Kopieren einer Eingabe in H oder J
die Spalten L oder N zu verwenden.
Ist nicht das Ziel der Prozedur, dass die Einträge in den Spalten H und J
bei Paarungen mit gleicher Nr. identisch sind? (Erbitte Antwort hierzu!)
Der Fehler (die genaue Angabe des Fehlerhinweises wäre praktisch gewesen!) tritt auf,
weil in deiner Excelversion der Find-Befehl den Parameter "SearchFormat" noch nicht kennt.
Lasse ihn weg, dann sieht der Befehl so aus:


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

Hallo Björn,
vielen Dank für die guten Wünsche. Ich hoffe, auch Du hast den Jahresübergang gut überstanden.
Auch Dir ein gutes Jahr 2008!
Zu meinem Problem:
Leider löst Dein Programmiervorschlag die Sache nicht (siehe auch Hinweis von Erich). Schade.
Könnte es sein, dass meine Excel-Version "(Excel-Version) evtl. anders "denkt" als Deine"
Beschreibung:
Wenn ich in das Tabellenblatt "Auswertung" die nachstehende Prozedur einfüge, funktioniert die Sache komplett , allerdings nur mit den Ziffern 1 bis 9.


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

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ereignis zeitweise mit Fehler

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread