|
Ok RPP63,
du wolltest es so :P
Sub Auswertung()
Dim i As Integer
Dim j As Integer
Dim d As Date
Dim aa As String
aa = 2016
Call clear(aa, 2, 10, 13, 12)
Call clear(aa, 31, 4, 13, 12)
Call VKZ(2, "SA", aa)
Call VKZ(3, "SP", aa)
Call VKZ(4, "SMI", aa)
Call VKZ(5, "SMA", aa)
Call VKZ(6, "KM", aa)
Call VKZ(7, "TE", aa)
Call VKZ(8, "EM", aa)
Call VKZ(9, "VFW", aa)
Call VKZ(10, "AKT", aa)
Call VKZ(11, "LAW/AUS", aa)
Call stat_mod(31, "VFW", aa)
Call stat_mod(32, "AKT", aa)
Call stat_mod(33, "LAW/AUS", aa)
Call stat_mod(34, "KFA", aa)
Call add(aa, 2, 11, 13, 9) 'Jahr,spalte, laufkonst,reihe,laufkonst.
Call add(aa, 31, 12, 13, 3)
End Sub
Sub VKZ(n As Integer, VK As String, jahr As String)
Dim k As Integer
Dim d As Integer
Dim a As Integer
For k = 1 To 300
If Worksheets(jahr).Cells(k + 1, 7) = VK Then
a = 0
d = Month(Worksheets(jahr).Cells(k + 1, 10).Value)
If d = 1 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 2 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 3 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 4 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 5 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 6 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 7 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 8 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 9 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 10 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 11 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
If d = 12 Then
a = Worksheets(jahr).Cells(n, d + 12)
Worksheets(jahr).Cells(n, d + 12) = a + 1
End If
End If
Next k
End Sub
Sub add(jahr As String, n As Integer, m As Integer, o As Integer, p As Integer)
Dim a As Integer
Dim i As Integer
Dim d As Integer
For j = 0 To m
a = 0
For i = 0 To p
a = a + Worksheets(jahr).Cells(n + i, j + o)
Next i
Worksheets(jahr).Cells(n + i, o + j) = a
Next j
'For j = 0 To 12
'a = 0
'For i = 0 To 3
'a = a + Worksheets(jahr).Cells(31 + i, j + 13)
'Next i
'Worksheets(jahr).Cells(12, 13 + j) = a
'Next j
End Sub
Sub stat_mod(n As Integer, VK As String, jahr As String)
Dim k As Integer
Dim d As String
Dim a As Integer
For k = 1 To 300
If Worksheets(jahr).Cells(k + 1, 1) = VK Then
a = 0
d = Worksheets(jahr).Cells(k + 1, 4)
If d = "Model1" Then
a = Worksheets(jahr).Cells(n, 13)
Worksheets(jahr).Cells(n, 13) = a + 1
End If
If d = "Model2" Then
a = Worksheets(jahr).Cells(n, 14)
Worksheets(jahr).Cells(n, 14) = a + 1
End If
If d = "Model3" Then
a = Worksheets(jahr).Cells(n, 15)
Worksheets(jahr).Cells(n, 15) = a + 1
End If
If d = "Model4" Then
a = Worksheets(jahr).Cells(n, 16)
Worksheets(jahr).Cells(n, 16) = a + 1
End If
If d = "Model5" Then
a = Worksheets(jahr).Cells(n, 17)
Worksheets(jahr).Cells(n, 17) = a + 1
End If
If d = "Model6" Then
a = Worksheets(jahr).Cells(n, 18)
Worksheets(jahr).Cells(n, 18) = a + 1
End If
If d = "Model7" Then
a = Worksheets(jahr).Cells(n, 19)
Worksheets(jahr).Cells(n, 19) = a + 1
End If
If d = "Model8" Then
a = Worksheets(jahr).Cells(n, 20)
Worksheets(jahr).Cells(n, 20) = a + 1
End If
If d = "Model9" Then
a = Worksheets(jahr).Cells(n, 21)
Worksheets(jahr).Cells(n, 21) = a + 1
End If
If d = "Model10" Then
a = Worksheets(jahr).Cells(n, 22)
Worksheets(jahr).Cells(n, 22) = a + 1
End If
If d = "Model11" Then
a = Worksheets(jahr).Cells(n, 23)
Worksheets(jahr).Cells(n, 23) = a + 1
End If
If d = "Model12" Then
a = Worksheets(jahr).Cells(n, 24)
Worksheets(jahr).Cells(n, 24) = a + 1
End If
If d = "Chr" Then
a = Worksheets(jahr).Cells(n, 25)
Worksheets(jahr).Cells(n, 25) = a + 1
End If
End If
Next k
End Sub
Sub clear(jahr As String, n As Integer, m As Integer, o As Integer, p As Integer)
For j = 0 To m
For i = 1 To o
Worksheets(jahr).Cells(n + j, p + i).clear
Next i
Next j
End Sub
|