Option Explicit
Sub tt()
MsgBox Wie("min", "2011", "1")
End Sub
Function Wie(Wat As String, Jaar As String, Kwart As String)
Dim Waarde As Double, bMax As Boolean, b As Boolean
Dim vt As Variant, c As Range, i As Integer, k As Integer, r As Integer
'Application.Volatile
With Sheets("sheet1").PivotTables(1) 'onze draaitabel
Select Case LCase(Wat)
Case "min": bMax = False 'je vraagt de minima
Case "max": bMax = True 'of de maxima
Case Else: Wie = "MinMax?": Exit Function 'iets anders mag niet
End Select
On Error Resume Next 'doorgaan bij fouten
b = False
k = .DataBodyRange.Columns.Count 'aantal kolommen in databodyrange
For i = 1 To k 'alle kolommen aflopen
Set c = .DataBodyRange.Cells(1, i) 'alle cellen in 1e rij van databody aflopen
vt = True 'maak vt iets anders dan string
vt = c.PivotCell.ColumnItems(2).Value 'geef vt de inhoud van columitems(2)
If VarType(vt) = 8 Then 'is vartype van vt een string, dan is het geen subtotaal
If c.PivotCell.ColumnItems(1).Value = Jaar And c.PivotCell.ColumnItems(2).Value = Kwart Then 'ons gevraagde jaar en kwartaal
k = i: b = True: Exit For 'k=nr van gezochte kolom en stop de loop
End If
End If
Next
If Not b Then Wie = "Kolom???": Exit Function
Waarde = .GetPivotData("min of score", "jaar", Jaar, "kwartaal", Kwart) 'even Waarde een waarde geven
For Each c In .DataBodyRange.Columns(k).Cells 'loop allle cellen in die kolom van de draaitabel af
vt = True 'maak vt iets anders dan een string
vt = c.PivotCell.RowItems(2).Value 'geef vt inhoud van rowitems(2)
If VarType(vt) = 8 And (1 <= VarType(c) And VarType(c) <= 5) Then 'vt is een getal
If Not bMax And Waarde > c.Value Or bMax And Waarde < c.Value Then 'je zoekt een minimum en de huidige waarde < huidig minimum of je zoekt maximum en ...
Wie = "" 'wis vorig resultaten
Waarde = c.Value 'nieuwe grenswaarde
End If
If Waarde = c.Value Then Wie = Wie & c.PivotCell.RowItems(2).Value & ", " 'alle personen die voldoen aan gestelde grenswaarde
End If
Next
End With
Wie = IIf(Wie <> "", Left(Wie, Len(Wie) - 2), "") 'ev. laatste 2 karakters wissen
End Function
