Ermittlung gefilterter Daten in vers. Abschnitten
24.11.2015 11:01:41
JB
ich habe eine große Anzahl Daten in Tabellen (Tabelle 1-4) auf mehreren Arbeitsblättern zusammengestellt. Für die Auswertung habe ich neue Arbeitsblätter erstellt (Analysis 72-..).
Spalte 1 und 4 in den Tabellen müssen so gefiltert sein, dass nur Werte >0 angezeigt werden. Anschließend ermittle ich den größten Wert in Spalte 4 und unterteile dieses Maximum in Bereiche der Größe 500. Für jeden Abschnitt (0...499, 500...999, ...) filtere ich in einer Schleife Spalte 4, sodass sie nur die Zahlen aus dem Bereich des jeweiligen Abschnitts enthält. Zusätzlich setze ich einen Filter in Spalte 6, um die Level zu erhalten, für die ich mich interessiere. Nun möchte ich die Zeilen der gefilterten Tabelle zählen, um die Anazahl der Events mit diesem bestimmten Level in diesem Abschnitt zu erhalten.
Das Problem: Der Befehl Subtotal funktioniert nicht, ich erhalte als Ergebnis immer 0. Außerdem bekomme ich bei i=66 die Fehlermeldung "Überlauf".
Ich hoffe ihr könnt mir helfen und mir sagen, wo im Code mir ein Fehler unterlaufen ist!
Vielen Dank im Voraus!
Sub workscope_data_analysis()
Dim Maximum As Long
Dim Minimum As Long
Dim t As Integer
Dim tables As Variant
Dim analysis As Variant
Dim TSO_sections_float As Single
Dim TSO_sections As Integer
Dim i As Integer
Dim lower_limit As Long
Dim upper_limit As Long
Dim TSO_step_size As Integer
Dim number_SC_levels As Integer
Dim w As Worksheet
tables = Array("Tabelle1", "Tabelle2", "Tabelle3", "Tabelle4")
analysis = Array("Analysis 72-21", "Analysis 72-22", "Analysis 72-23", "Analysis 72-61")
t = 0
For Each w In Worksheets
If w.Name Like "72*" Then
' Filter data
w.Activate
If w.FilterMode Then w.ShowAllData
w.ListObjects(tables(t)).Range.AutoFilter Field:=1, Criteria1:=">0",Operator:= _
xlFilterValues
w.ListObjects(tables(t)).Range.AutoFilter Field:=4, Criteria1:=">0",Operator:= _
xlFilterValues
' Get minimum and maximum TSO
Maximum = w.Application.WorksheetFunction.MAX(Range("D3:D600"))
Minimum = w.Application.WorksheetFunction.MIN(Range("D3:D600"))
' Compute number of TSO sections
TSO_step_size = 500 ' Set TSO step size
TSO_sections_float = Maximum / TSO_step_size
' Round to next full number
TSO_sections = Application.WorksheetFunction.RoundUp(TSO_sections_float, 0)
Worksheets(analysis(t)).Cells(2, 2).Value = Minimum
Worksheets(analysis(t)).Cells(3, 2).Value = Maximum
Worksheets(analysis(t)).Cells(2, 1).Value = "Minimum TSO: "
Worksheets(analysis(t)).Cells(3, 1).Value = "Maximum TSO: "
Worksheets(analysis(t)).Cells(4, 2).Value = TSO_sections
Worksheets(analysis(t)).Cells(4, 1).Value = "Number of TSO sections: "
' Count number of ws events (S/C) per TSO_section
upper_limit = 0 'Initialize upper limit
For i = 1 To TSO_sections ' Loop over each TSO_section
lower_limit = upper_limit
upper_limit = i * TSO_step_size
w.Activate
' Set filter for workscope level and TSO_section
w.ListObjects(tables(t)).Range.AutoFilter Field:=6,Criteria1:="S/C", Operator: _
_
=xlFilterValues
w.ListObjects(tables(t)).Range.AutoFilter Field:=4,Criteria1:=">=lower_limit", _
Operator:=xlAnd, Criteria2:="0 in column 4
w.ListObjects(tables(t)).Range.AutoFilter Field:=4
w.ListObjects(tables(t)).Range.AutoFilter Field:=4,Criteria1:=">0", Operator:= _
xlFilterValues
w.ListObjects(tables(t)).Range.AutoFilter Field:=6
Next
' Create graph
' Last step: Show all data (S/N and TSO >0) and sort by S/N and date
w.Activate
If w.FilterMode Then w.ShowAllData
w.ListObjects(tables(t)).Range.AutoFilter Field:=1, Criteria1:=">0",Operator:= _
xlFilterValues
w.ListObjects(tables(t)).Range.AutoFilter Field:=4, Criteria1:=">0",Operator:= _
xlFilterValues
w.ListObjects(tables(t)).Sort.SortFields.Clear
w.ListObjects(tables(t)).Sort. _
SortFields.Add Key:=Range(tables(t) & "[[#All],[Date]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With w.ListObjects(tables(t)).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Then sort S/N number
w.ListObjects(tables(t)).Sort.SortFields.Clear
w.ListObjects(tables(t)).Sort. _
SortFields.Add Key:=Range(tables(t) & "[[#All],[S/N]]"),SortOn:=xlSortOnValues _
, Order:=xlAscending, DataOption:=xlSortNormal
With w.ListObjects(tables(t)).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Initialize next table
t = t + 1
End If
Next w
End Sub