Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1076to1080
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Worksheet-Change zweimal

Worksheet-Change zweimal
04.06.2009 20:18:59
Karel
Hallo und Guteabend,
wie kann ich die beiden Worksheet-Change Ereignisse zu einem zusammenfassen?
mein kentnisse reiche nicht aus für diese Problem.
code von Tino und Hajo
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim rngKrit As Range
If Target.Address = "$F$1" Or Target.Address = "$A$1" Then
With Tabelle26
Set Bereich = .Range("A2:P" & .Cells(.Rows.Count, 6).End(xlUp).Row)
Set rngKrit = .Range("Q2", IIf(.Range("R3")  "", .Range("R3"), .Range("Q3")))
End With
With Tabelle9
Bereich.AdvancedFilter xlFilterCopy, rngKrit, .Range("B4:I4"), False
Set Bereich = .Range("A4:G" & .Cells.SpecialCells(xlCellTypeLastCell).Row)
Bereich.Sort Bereich(1, 5), xlAscending, Bereich(1, 6), , xlAscending, , , xlYes
End With
End If
End Sub



Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range
Dim RaZelle As Range
Set RaBereich = Range("F3:F20000")
ActiveSheet.Unprotect
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If RaBereich Is Nothing Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each RaZelle In RaBereich
If RaZelle = "" Then
RaZelle.Offset(0, 9) = ""
ElseIf RaZelle.Offset(0, 9) = "" Then
RaZelle.Offset(0, 9) = Date
End If
Next RaZelle
ActiveSheet.protect
Application.ScreenUpdating = True
Application.EnableEvents = True
Set RaBereich = Nothing
End Sub


Grusse
Karel

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Worksheet-Change zweimal
04.06.2009 20:22:43
Hajo_Zi
Hallo Karel,

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim rngKrit As Range
Dim RaBereich As Range
Dim RaZelle As Range
Set RaBereich = Range("F3:F20000")
If Target.Address = "$F$1" Or Target.Address = "$A$1" Then
With Tabelle26
Set Bereich = .Range("A2:P" & .Cells(.Rows.Count, 6).End(xlUp).Row)
Set rngKrit = .Range("Q2", IIf(.Range("R3")  "", .Range("R3"), .Range("Q3")))
End With
With Tabelle9
Bereich.AdvancedFilter xlFilterCopy, rngKrit, .Range("B4:I4"), False
Set Bereich = .Range("A4:G" & .Cells.SpecialCells(xlCellTypeLastCell).Row)
Bereich.Sort Bereich(1, 5), xlAscending, Bereich(1, 6), , xlAscending, , , xlYes
End With
End If
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each RaZelle In RaBereich
If RaZelle = "" Then
RaZelle.Offset(0, 9) = ""
ElseIf RaZelle.Offset(0, 9) = "" Then
RaZelle.Offset(0, 9) = Date
End If
Next RaZelle
ActiveSheet.Protect
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
Set RaBereich = Nothing
End Sub



Anzeige
AW: Worksheet-Change zweimal
04.06.2009 20:30:07
Karel
Hallo Hajo,
Schneller gehts nicht mir
Viele Dank und Grusse
Karel

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige