Zählen wenn dynamisch aus Zelle
09.11.2015 21:22:58
Alex
ich hoffe jemand kann mir helfen :-)
Es kommt immer die Meldung "Nicht genügend Speicher" das liegt wahrscheinlich bei meiner Abfrage. (siehe code) dieser Code benutze ich merehre male im Modul und frage entsprechende sachen ab und zähle sie dann. z.B. in "Worksheets("Abfrage").Range("j9") steht die Kalenderwoche 46,47,48,49, usw. und in der Spalte "k9" das entsprechende Jahr 2015 , 2016.
Er soll mir Zählen wie oft z.B. Kalenderwoche 46 und 2015 vorkommt und mir das Ergebniss in einer entsprechenden Zeile kopieren in Worksheet Menü.
kann man das irgendwie vereinfachen ?
vielen dank im Voraus.
Sub zaehlen_KW_dy()
Dim i As Long
Dim z, x, y, a, b, c, d, xa, ya, aa, ba, ca, da As Integer
Dim Zeile As Integer
Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13 As Range
Dim ab1, ab2, ab3, ab4, ab5, ab6, ab7, ab8, ab9, ab10, ab11, ab12, ab13 As Range
Worksheets("Tabelle2").Select
z = 0
x = 0
y = 0
a = 0
b = 0
c = 0
d = 0
z = 0
xa = 0
ya = 0
aa = 0
ba = 0
ca = 0
da = 0
Zeile = 1
a1 = Worksheets("Abfrage").Range("j9").Value
a2 = Worksheets("Abfrage").Range("j10").Value
a3 = Worksheets("Abfrage").Range("j11").Value
a4 = Worksheets("Abfrage").Range("j12").Value
a5 = Worksheets("Abfrage").Range("j13").Value
a6 = Worksheets("Abfrage").Range("j14").Value
a7 = Worksheets("Abfrage").Range("j15").Value
a8 = Worksheets("Abfrage").Range("j16").Value
a9 = Worksheets("Abfrage").Range("j17").Value
a10 = Worksheets("Abfrage").Range("j18").Value
a11 = Worksheets("Abfrage").Range("j19").Value
a12 = Worksheets("Abfrage").Range("j20").Value
ab1 = Worksheets("Abfrage").Range("k9").Value
ab2 = Worksheets("Abfrage").Range("k10").Value
ab3 = Worksheets("Abfrage").Range("k11").Value
ab4 = Worksheets("Abfrage").Range("k12").Value
ab5 = Worksheets("Abfrage").Range("k13").Value
ab6 = Worksheets("Abfrage").Range("k14").Value
ab7 = Worksheets("Abfrage").Range("k15").Value
ab8 = Worksheets("Abfrage").Range("k16").Value
ab9 = Worksheets("Abfrage").Range("k17").Value
ab10 = Worksheets("Abfrage").Range("k18").Value
ab11 = Worksheets("Abfrage").Range("k19").Value
ab12 = Worksheets("Abfrage").Range("k20").Value
For i = [o65536].End(xlUp).Row To Zeile Step -1
If Cells(i, 28) = ab1 And Cells(i, 29) = a1 Then
x = x + 1
End If
If Cells(i, 28) = ab2 And Cells(i, 29) = a2 Then
y = y + 1
End If
If Cells(i, 28) = ab3 And Cells(i, 29) = a3 Then
a = a + 1
End If
If Cells(i, 28) = ab4 And Cells(i, 29) = a4 Then
b = b + 1
End If
If Cells(i, 28) = ab5 And Cells(i, 29) = a5 Then
c = c + 1
End If
If Cells(i, 28) = ab6 And Cells(i, 29) = a6 Then
xa = xa + 1
End If
If Cells(i, 28) = ab7 And Cells(i, 29) = a7 Then
ya = ya + 1
End If
If Cells(i, 28) = ab8 And Cells(i, 29) = a8 Then
aa = aa + 1
End If
If Cells(i, 28) = ab9 And Cells(i, 29) = a9 Then
ba = ba + 1
End If
If Cells(i, 28) = ab10 And Cells(i, 29) = a10 Then
ca = ca + 1
End If
If Cells(i, 28) = ab11 And Cells(i, 29) = a11 Then
da = da + 1
End If
If Cells(i, 28) = ab12 And Cells(i, 29) = a12 Then
z = z + 1
End If
Next i
'MsgBox z & " Treffer"
Worksheets("Menü").Range("L17").Value = x
'MsgBox x & " Treffer"
Worksheets("Menü").Range("M17").Value = y
'MsgBox y & " Treffer"
Worksheets("Menü").Range("N17").Value = a
'MsgBox a & " Treffer"
Worksheets("Menü").Range("O17").Value = b
'MsgBox b & " Treffer"
Worksheets("Menü").Range("P17").Value = c
'MsgBox c & " Treffer"
Worksheets("Menü").Range("Q17").Value = xa
Worksheets("Menü").Range("L25").Value = ya
Worksheets("Menü").Range("M25").Value = aa
Worksheets("Menü").Range("N25").Value = ba
Worksheets("Menü").Range("O25").Value = ca
Worksheets("Menü").Range("P25").Value = da
Worksheets("Menü").Range("Q25").Value = z
End Sub