Spalten geändert
07.05.2013 01:17:05
Erich
Hi Alex,
zuerst mal: Danke für die gute Note! ;-)
Die Spaltenänderung macht es kaum länger:
Sub AuswertBQR()
Dim lngQ As Long, arB, arQ, strT As String, qq As Long, jm As Long
Dim lngM As Long, datJM() As Long, datB, lngE() As Long
Dim lngV As Long
With Sheets("Daten")
lngQ = .Cells(.Rows.Count, 2).End(xlUp).Row - 1
arB = .Cells(2, 2).Resize(lngQ).Value
arQ = .Cells(2, 17).Resize(lngQ, 2).Value
End With
With Sheets("Ausw")
strT = Cells(2, 1)
lngM = .Cells(4, .Columns.Count).End(xlToLeft).Column - 1
datB = Cells(4, 2).Resize(, lngM).Value
lngV = 12 * Year(datB(1, 1)) + Month(datB(1, 1)) - 1
ReDim datJM(1 To 12 * Year(datB(1, lngM)) + Month(datB(1, lngM)) - lngV)
Cells(7, 2).Resize(, UBound(datJM) - LBound(datJM) + 1).ClearContents
For qq = 1 To lngQ
If IsEmpty(arQ(qq, 2)) Then
If arB(qq, 1) = strT Then
jm = 12 * Year(arQ(qq, 1)) + Month(arQ(qq, 1)) - lngV
' If jm UBound(datJM) Then
' MsgBox "Falsches Datum " & arQ(qq, 1)
' Else
datJM(jm) = datJM(jm) + 1
' End If
End If
End If
Next qq
Cells(7, 2).Resize(, UBound(datJM) - LBound(datJM) + 1) = datJM
lngM = .Cells(11, .Columns.Count).End(xlToLeft).Column - 1
datB = Cells(11, 2).Resize(, lngM).Value
lngV = 12 * Year(datB(1, 1)) + Month(datB(1, 1)) - 1
ReDim datJM(1 To 12 * Year(datB(1, lngM)) + Month(datB(1, lngM)) - lngV)
Cells(14, 2).Resize(, UBound(datJM) - LBound(datJM) + 1).ClearContents
For qq = 1 To lngQ
If IsEmpty(arQ(qq, 2)) Then
If (arB(qq, 1) = "Typ B" Or arB(qq, 1) = "Typ C") Then
jm = 12 * Year(arQ(qq, 1)) + Month(arQ(qq, 1)) - lngV
datJM(jm) = datJM(jm) + 1
End If
End If
Next qq
Cells(14, 2).Resize(, UBound(datJM) - LBound(datJM) + 1) = datJM
End With
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich