From 77aa3c336650c3472678c7c4be869a8bfa067393 Mon Sep 17 00:00:00 2001 From: Trowbridge Date: Wed, 27 Feb 2019 19:50:49 -0500 Subject: [PATCH] update pivot interpreter --- pivot.bas | 95 +++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 85 insertions(+), 10 deletions(-) diff --git a/pivot.bas b/pivot.bas index e8a83b1..86bf9ae 100644 --- a/pivot.bas +++ b/pivot.bas @@ -1,6 +1,17 @@ -Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) +Option Explicit - 'Exit Sub +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 + 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 + + +