Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1220to1224
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

Makro als Ereignismakro

Makro als Ereignismakro
Michael
Guten Morgen,
ich möchte nachfolgendes Makro als Ereignismakro einsetzen. Beim Aktivieren des Blattes Tabelle 1 soll es ausgeführt werden. Klappt aber in dieser Form nicht, weil die Aktivierungen der Blätter im Makro natürlich Fehlermeldungen und am Ende eine Schleife auslösen.
Kriegt man das irgendwie in den Griff?
Vielen Dank
Michael

Sub Test
Dim i As Long, LastRow As Long, NoRevDay As Long, MyRange As Range, Msg As String
Dim SameDateCnt As Long, DateArr() As Variant
Application.ScreenUpdating = False
Worksheets("Tabelle 1").Activate
LastRow = Range("L65536").End(xlUp).Row
NoRevDay = 0
For i = 1 To LastRow
If IsDate(Cells(i, 12).Value) = True Then
'Myrange setzen fuer selbes Datum
For SameDateCnt = 1 To 26
If Cells(i + SameDateCnt, 12).Value  Cells(i, 12).Value Then
SameDateCnt = SameDateCnt - 1
Exit For
End If
Next SameDateCnt
Set MyRange = Range(Cells(i, 12), Cells(i + SameDateCnt, 12))
If Application.CountIf(MyRange.Offset(0, 29), ">0.05") = 0 Then
NoRevDay = NoRevDay + 1
ReDim Preserve DateArr(NoRevDay)
DateArr(NoRevDay) = Cells(i, 12).Value
i = i + SameDateCnt
Else
i = i + SameDateCnt
End If
End If
Next i
Worksheets("Tabelle2").Activate
Cells(43, 14).Value = NoRevDay
For i = LBound(DateArr) To UBound(DateArr)
If DateArr(i)  "" Then
Cells(43, 16 + i) = DateArr(i)
End If
Next i
Application.ScreenUpdating = True
End Sub

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

Betreff
Benutzer
Anzeige
AW: Makro als Ereignismakro
01.07.2011 09:10:00
Rudi
Hallo,
kann man, wenn man auf Activate verzichtet.
Sub Test()
Dim i As Long, LastRow As Long, NoRevDay As Long, MyRange As Range, Msg As String
Dim SameDateCnt As Long, DateArr() As Variant
Application.ScreenUpdating = False
With Worksheets("Tabelle 1")
LastRow = .Range("L65536").End(xlUp).Row
NoRevDay = 0
For i = 1 To LastRow
If IsDate(.Cells(i, 12).Value) = True Then
'Myrange setzen fuer selbes Datum
For SameDateCnt = 1 To 26
If .Cells(i + SameDateCnt, 12).Value  .Cells(i, 12).Value Then
SameDateCnt = SameDateCnt - 1
Exit For
End If
Next SameDateCnt
Set MyRange = .Range(.Cells(i, 12), .Cells(i + SameDateCnt, 12))
If Application.CountIf(MyRange.Offset(0, 29), ">0.05") = 0 Then
NoRevDay = NoRevDay + 1
ReDim Preserve DateArr(NoRevDay)
DateArr(NoRevDay) = .Cells(i, 12).Value
i = i + SameDateCnt
Else
i = i + SameDateCnt
End If
End If
Next i
End With
With Worksheets("Tabelle2")
.Cells(43, 14).Value = NoRevDay
For i = LBound(DateArr) To UBound(DateArr)
If DateArr(i)  "" Then
.Cells(43, 16 + i) = DateArr(i)
End If
Next i
End With
Application.ScreenUpdating = True
End Sub

Gruß
Rudi
Anzeige
Danke
01.07.2011 09:30:36
Michael
Hallo Rudi,
vielen Dank, hat mir sehr weiter geholfen.
Gruß
Michael

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige