Makroproblem !
10.06.2009 08:46:43
Ernst
https://www.herber.de/bbs/user/62289.zip
Ich würde eure Hilfe benötigen, es geht um ein Abfragemakro, wenn im Tabellenblatt2 Archiv Abfrage(Alle)
Das Datum (von) und das Datum (bis) eingegeben wird soll die Anzahl der jeweiligen Type sowie die Gesamtanzahl der im ausgewählten Zeitraum gereinigten Nr. in den Ausgabefeldern erscheinen.
Bei bestehender Lösung werden immer alle gezählt egal welchen Zeitraum ich abfrage !
Wäre für Lösungsvorschläge dankbar.
lg.Ernst
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim n As Integer
Dim S As Integer
Dim RL As Range
Dim Zx As Long
Dim RA As Range
If Target.Address = "$G$2" Then
If IsDate(Target.Value) And IsDate(Target.Offset(0, -2).Value) Then
If Target.Value > Target.Offset(0, -2).Value Then
Zx = Worksheets("Archiv").Cells(Rows.Count, 1).End(xlUp).Row
Application.EnableEvents = False
Target.Offset(0, 2).Value = 0
Target.Offset(0, 4).Value = 0
Target.Offset(0, 6).Value = 0
For Each RL In Worksheets("Archiv").Range("A5:A" & CStr(Zx))
S = Zuordnung(RL.Value)
Select Case S
Case 1
n = 2
Case 5
n = 4
Case 9
n = 6
End Select
Zx = Worksheets("Archiv").Cells(RL.Row, Columns.Count).End(xlToLeft).Column - 1
Target.Offset(0, n).Value = Target.Offset(0, n).Value + Zx
Next
Application.EnableEvents = True
End If
End If
End If
If Target.Address = "$K$4" Then
If IsDate(Target.Offset(0, -4).Value) And IsDate(Target.Offset(0, -2).Value) Then
If Target.Offset(0, -2).Value > Target.Offset(0, -4).Value Then
Zx = Worksheets("Archiv").Cells(Rows.Count, 1).End(xlUp).Row
Application.EnableEvents = False
Target.Offset(0, 2).Value = 0
For Each RL In Worksheets("Archiv").Range("A5:A" & CStr(Zx))
If RL.Value = Worksheets("Archiv").Range("K4").Value Then
Zx = Worksheets("Archiv").Cells(RL.Row, Columns.Count).End(xlToLeft).Column _
- 1
Target.Offset(0, 2).Value = Target.Offset(0, 2).Value + Zx
End If
Next
Application.EnableEvents = True
End If
End If
End If
End Sub
Function Zuordnung(Vx As Variant)
Dim Zeilen As Long
Dim Spalte As Long
Dim K As Long, Vy
For Spalte = 1 To 9 Step 4
Zeilen = Worksheets("Flor-Kag-Brg").Cells(Rows.Count, Spalte).End(xlUp).Row
For K = 8 To Worksheets("Flor-Kag-Brg").Cells(Rows.Count, Spalte).End(xlUp).Row
Vy = Worksheets("Flor-Kag-Brg").Cells(K, Spalte).Value
If Worksheets("Flor-Kag-Brg").Cells(K, Spalte).Value = Vx Then
Zuordnung = Spalte
Exit Function
End If
Next
Next
End Function
