update pivot interpreter
This commit is contained in:
		
							parent
							
								
									cc7a4a7e08
								
							
						
					
					
						commit
						77aa3c3366
					
				
							
								
								
									
										95
									
								
								pivot.bas
									
									
									
									
									
								
							
							
						
						
									
										95
									
								
								pivot.bas
									
									
									
									
									
								
							| @ -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 | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user