AW: Statistik
11.09.2008 12:19:00
fcs
Hallo Friedel,
genau 50 Datenzeilen-Markierungen je Segment bekommt man nur schwierig hin, da für die Bestimmumg der zu markierenden Zeilen je Segment einige Rundungen und Vorgaben in den Berechnungen gemacht werden müssen.
Hier eine Makro-Lösung. Markiert wird nach den Untersegmenten in Spalte B. Falls du nach Spalte A markieren willst, dann muss du die entsprechende Konstante von 2 auf 1 ändern.
Für die Markierung der Segmente in Spalte A könnte man auch noch eine Formellösung hinbekommen, die aber bei 25000 Zeilen sehr rechenintensiv ist.
Gruß
Franz
Sub aaMarkieren()
Dim wks As Worksheet
Dim lngZeile As Long, lngSchritt As Long
Dim lngZeile1 As Long, lngzeile2 As Long
Dim varWertA
Dim varWertSegment, lngCountSegment As Long
Const lngSpMark As Long = 6 'Spalte (F) für Markierung
Const lngSpSegment As Long = 2 'Spalte (B) mit Unter-Segmenten die markiert weren sollen
Const lngZeilenSegment As Long = 50 'Anzahl zu markierende Zeilen pro Unter-Segment
Set wks = ActiveSheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With wks
'vorhandene Markierungen löschen
If .Cells(.Rows.Count, lngSpMark).End(xlUp).Row > 1 Then
.Range(.Cells(2, lngSpMark), .Cells(.Rows.Count, lngSpMark).End(xlUp)).ClearContents
End If
'sortieren nach Spalte A und B
With .Range(.Rows(1), .Rows(.Cells(.Rows.Count, 1).End(xlUp).Row))
.Sort key1:=.Range("A1"), Order1:=xlAscending, _
Key2:=.Range("B1"), order2:=xlAscending, _
Header:=xlYes
End With
For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Wert Spalte A prüfen ob neues Segment beginnt, ggf. Wert einlesen
If varWertA .Cells(lngZeile, 1) Then
varWertA = .Cells(lngZeile, 1)
'Segmentwert zurücksetzen
varWertSegment = ""
'1. zeile des Segments in Spalte A
lngZeile1 = lngZeile
'letzte Zeile des Segments in Spalte A ermitteln
lngzeile2 = lngZeile
Do Until .Cells(lngzeile2 + 1, 1) varWertA
lngzeile2 = lngzeile2 + 1
Loop
End If
'Wert in Untersegmentspalte prüfen, ob neues Segment beginnt
If varWertSegment .Cells(lngZeile, lngSpSegment).Value Then
'neuen Wert aus Unter-Segment Spalte einlesen
varWertSegment = .Cells(lngZeile, lngSpSegment).Value
'Anzahl Einträge für Wert
lngCountSegment = Application.WorksheetFunction.CountIf(.Range(.Cells(lngZeile1, _
lngSpSegment), .Cells(lngzeile2, lngSpSegment)), varWertSegment)
'Zeilenschrittweite für Markierung
With Application.WorksheetFunction
lngSchritt = .Max(.Round(lngCountSegment / lngZeilenSegment, 0), 2)
End With
End If
If lngCountSegment