update pivot interpreter

This commit is contained in:
Trowbridge 2019-02-27 19:50:49 -05:00
parent cc7a4a7e08
commit 77aa3c3366

View File

@ -1,6 +1,17 @@
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean)
If Intersect(Target, ActiveSheet.range("b11:v100000")) Is Nothing Then
Exit Sub
End If
On Error GoTo nopiv
If Target.Cells.PivotTable Is Nothing Then
Exit Sub
End If
'Exit Sub
Cancel = True
@ -15,6 +26,14 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
Dim cd As Object
Dim dd As Object
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim wapi As New Windows_API
Set ri = Target.Cells.PivotCell.RowItems
Set ci = Target.Cells.PivotCell.ColumnItems
Set df = Target.Cells.PivotCell.DataField
@ -22,23 +41,64 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
Set rd = Target.Cells.PivotTable.RowFields
Set cd = Target.Cells.PivotTable.ColumnFields
Dim sql As String
ReDim handler.sc(ri.Count, 1)
Set pt = Target.Cells.PivotCell.PivotTable
handler.sql = ""
handler.jsql = ""
For i = 1 To ri.Count
If i <> 1 Then sql = sql & vbCrLf & "AND "
sql = sql & rd(piv_pos(rd, i)).Name & " = '" & ri(i).Name & "'"
If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & ri(i).Name & "'"
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & ri(i).Name & """"
handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
handler.sc(i - 1, 1) = ri(i).Name
'the following looks for filtered items, but this is redundant because a single one has been isolated
'For Each pi In pt.PivotFields(piv_fld_index(rd(i).Name, pt)).PivotItems
' If Not pi.Visible Then
' sql = sql & vbCrLf & "AND " & rd(i).Name & " <> '" & pi.Name & "'"
' End If
'Next pi
Next i
For i = 1 To ci.Count
sql = sql & vbCrLf & "AND "
sql = sql & cd(piv_pos(cd, ci(i).Parent.Position)).Name & " = '" & ci(i).Name & "'"
Next i
'this block loops through items selected in colums, which will be ignored for now
'For i = 1 To ci.Count
' sql = sql & vbCrLf & "AND "
' sql = sql & cd(piv_pos(cd, ci(i).Parent.Position)).Name & " = '" & ci(i).Name & "'"
'Next i
MsgBox (sql)
'this loop iterates through every pivot field (even if not in the PT) and determines filtered items
'For Each pf In Target.Cells.PivotTable.PivotFields
' For Each pi In pf.PivotItems
' If Not pi.Visible Then
' sql = sql & vbCrLf & "AND " & pf.Name & " <> '" & pi.Name & "'"
' End If
' Next pi
'Next pf
scenario = "{" & handler.jsql & "}"
'Sheets("test").Cells(1, 14) = handler.jsql
Call handler.load_fpvt
'Call http.pull_months(scenario)
'jsql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE j @> '{" & jsql & "}'::jsonb"
'sql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE " & sql
'MsgBox (sql)
'Call wapi.ClipBoard_SetData(sql)
nopiv:
End Sub
Function piv_pos(list As Object, target_pos As Long) As Long
Dim i As Long
For i = 1 To list.Count
@ -49,5 +109,20 @@ Function piv_pos(list As Object, target_pos As Long) As Long
Next i
'should not get to this point
End Function
Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
Dim i As Integer
For i = 1 To pt.PivotFields.Count
If pt.PivotFields(i).Name = field_name Then
piv_fld_index = i
Exit Function
End If
Next i
End Function