Add options to query by director or segment. Also speed it up A LOT.
This commit is contained in:
PhilRunninger
parent
cecd647ee7
commit
eb03d61600
BIN
VBA/build.frx
BIN
VBA/build.frx
Binary file not shown.
BIN
VBA/changes.frx
BIN
VBA/changes.frx
Binary file not shown.
BIN
VBA/fpvt.frx
BIN
VBA/fpvt.frx
Binary file not shown.
302
VBA/handler.bas
302
VBA/handler.bas
@ -18,24 +18,24 @@ Public adjust() As Variant
|
||||
Sub load_fpvt()
|
||||
|
||||
Application.StatusBar = "retrieving selection data....."
|
||||
|
||||
|
||||
Dim i As Long
|
||||
Dim s_tot As Object
|
||||
|
||||
|
||||
fpvt.lbSDET.list = handler.sc
|
||||
|
||||
|
||||
showprice = False
|
||||
|
||||
|
||||
For i = 0 To UBound(handler.sc, 1)
|
||||
If handler.sc(i, 0) = "part_descr" Then
|
||||
showprice = True
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
|
||||
|
||||
|
||||
|
||||
fpvt.Show
|
||||
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
@ -45,21 +45,25 @@ Function scenario_package(doc As String, ByRef status As Boolean) As Object
|
||||
Dim req As New WinHttp.WinHttpRequest
|
||||
Dim json As Object
|
||||
Dim wr As String
|
||||
|
||||
|
||||
On Error GoTo errh
|
||||
|
||||
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
.Open "GET", server & "/scenario_package", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
Debug.Print "GET /scenario_package (";
|
||||
Dim t As Single
|
||||
t = Timer
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
Debug.Print Timer - t; "sec): "; Left(wr, 200)
|
||||
End With
|
||||
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
Set scenario_package = json
|
||||
|
||||
|
||||
errh:
|
||||
If Err.Number <> 0 Then
|
||||
status = False
|
||||
@ -68,82 +72,48 @@ errh:
|
||||
Else
|
||||
status = True
|
||||
End If
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Sub pg_main_workset(rep As String)
|
||||
|
||||
Sub pg_main_workset(catg As String, rep As String)
|
||||
|
||||
Dim req As New WinHttp.WinHttpRequest
|
||||
Dim wr As String
|
||||
Dim json As Object
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim doc As String
|
||||
Dim res() As Variant
|
||||
Dim str() As String
|
||||
|
||||
doc = "{""scenario"":{""" & catg & """:""" & rep & """}}"
|
||||
|
||||
doc = "{""quota_rep"":""" & rep & """}"
|
||||
|
||||
Application.StatusBar = "Querying for " & rep & "'s pool of data..."
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
.Open "GET", handler.server & "/get_pool", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
Debug.Print "GET /get_pool (";
|
||||
Dim t As Single
|
||||
t = Timer
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
Debug.Print Timer - t; "sec): "; Left(wr, 200)
|
||||
End With
|
||||
|
||||
If Mid(wr, 1, 1) <> "{" Then
|
||||
MsgBox (wr)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Application.StatusBar = "Parsing query results..."
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
|
||||
|
||||
If IsNull(json("x")) Then
|
||||
MsgBox "No data found for " & rep & "."
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ReDim res(json("x").Count, 34)
|
||||
|
||||
For i = 1 To UBound(res, 1)
|
||||
res(i, 0) = json("x")(i)("bill_cust_descr")
|
||||
res(i, 1) = json("x")(i)("billto_group")
|
||||
res(i, 2) = json("x")(i)("ship_cust_descr")
|
||||
res(i, 3) = json("x")(i)("shipto_group")
|
||||
res(i, 4) = json("x")(i)("quota_rep_descr")
|
||||
res(i, 5) = json("x")(i)("director")
|
||||
res(i, 6) = json("x")(i)("segm")
|
||||
res(i, 7) = json("x")(i)("substance")
|
||||
res(i, 8) = json("x")(i)("chan")
|
||||
res(i, 9) = json("x")(i)("chansub")
|
||||
res(i, 10) = json("x")(i)("part_descr")
|
||||
res(i, 11) = json("x")(i)("part_group")
|
||||
res(i, 12) = json("x")(i)("branding")
|
||||
res(i, 13) = json("x")(i)("majg_descr")
|
||||
res(i, 14) = json("x")(i)("ming_descr")
|
||||
res(i, 15) = json("x")(i)("majs_descr")
|
||||
res(i, 16) = json("x")(i)("mins_descr")
|
||||
res(i, 17) = json("x")(i)("order_season")
|
||||
res(i, 18) = json("x")(i)("order_month")
|
||||
res(i, 19) = json("x")(i)("ship_season")
|
||||
res(i, 20) = json("x")(i)("ship_month")
|
||||
res(i, 21) = json("x")(i)("request_season")
|
||||
res(i, 22) = json("x")(i)("request_month")
|
||||
res(i, 23) = json("x")(i)("promo")
|
||||
res(i, 24) = json("x")(i)("value_loc")
|
||||
res(i, 25) = json("x")(i)("value_usd")
|
||||
res(i, 26) = json("x")(i)("cost_loc")
|
||||
res(i, 27) = json("x")(i)("cost_usd")
|
||||
res(i, 28) = json("x")(i)("units")
|
||||
res(i, 29) = json("x")(i)("version")
|
||||
res(i, 30) = json("x")(i)("iter")
|
||||
res(i, 31) = json("x")(i)("logid")
|
||||
res(i, 32) = json("x")(i)("tag")
|
||||
res(i, 33) = json("x")(i)("comment")
|
||||
res(i, 34) = json("x")(i)("pounds")
|
||||
Next i
|
||||
|
||||
|
||||
ReDim res(0, 34)
|
||||
res(0, 0) = "bill_cust_descr"
|
||||
res(0, 1) = "billto_group"
|
||||
res(0, 2) = "ship_cust_descr"
|
||||
@ -179,21 +149,82 @@ Sub pg_main_workset(rep As String)
|
||||
res(0, 32) = "tag"
|
||||
res(0, 33) = "comment"
|
||||
res(0, 34) = "pounds"
|
||||
|
||||
Set json = Nothing
|
||||
|
||||
ReDim str(UBound(res, 1), UBound(res, 2))
|
||||
|
||||
shData.Cells.ClearContents
|
||||
Call Utils.SHTp_DumpVar(res, shData.Name, 1, 1, False, True, True)
|
||||
|
||||
|
||||
Dim batchSize As Integer
|
||||
batchSize = 1000
|
||||
Dim totalRows As Long
|
||||
totalRows = json("x").Count
|
||||
Dim jsonRow As Long
|
||||
jsonRow = 1
|
||||
Dim sheetRow As Long
|
||||
sheetRow = 2
|
||||
Dim arrayRow As Long
|
||||
|
||||
' While the JSON array still has rows,
|
||||
' 1. move the 1st one to a VBA 2-D array, deleting it from the JSON array.
|
||||
' 2. When 1000 have been copied, put the values onto the worksheet, and
|
||||
' empty the VBA array.
|
||||
' Splitting the JSON array into smaller batches when creating the VBA array
|
||||
' means there is less memory needed for the operation.
|
||||
Do While json("x").Count > 0
|
||||
If jsonRow Mod batchSize = 1 Then
|
||||
ReDim res(batchSize - 1, 34)
|
||||
arrayRow = 0
|
||||
End If
|
||||
res(arrayRow, 0) = json("x")(1)("bill_cust_descr")
|
||||
res(arrayRow, 1) = json("x")(1)("billto_group")
|
||||
res(arrayRow, 2) = json("x")(1)("ship_cust_descr")
|
||||
res(arrayRow, 3) = json("x")(1)("shipto_group")
|
||||
res(arrayRow, 4) = json("x")(1)("quota_rep_descr")
|
||||
res(arrayRow, 5) = json("x")(1)("director")
|
||||
res(arrayRow, 6) = json("x")(1)("segm")
|
||||
res(arrayRow, 7) = json("x")(1)("substance")
|
||||
res(arrayRow, 8) = json("x")(1)("chan")
|
||||
res(arrayRow, 9) = json("x")(1)("chansub")
|
||||
res(arrayRow, 10) = json("x")(1)("part_descr")
|
||||
res(arrayRow, 11) = json("x")(1)("part_group")
|
||||
res(arrayRow, 12) = json("x")(1)("branding")
|
||||
res(arrayRow, 13) = json("x")(1)("majg_descr")
|
||||
res(arrayRow, 14) = json("x")(1)("ming_descr")
|
||||
res(arrayRow, 15) = json("x")(1)("majs_descr")
|
||||
res(arrayRow, 16) = json("x")(1)("mins_descr")
|
||||
res(arrayRow, 17) = json("x")(1)("order_season")
|
||||
res(arrayRow, 18) = json("x")(1)("order_month")
|
||||
res(arrayRow, 19) = json("x")(1)("ship_season")
|
||||
res(arrayRow, 20) = json("x")(1)("ship_month")
|
||||
res(arrayRow, 21) = json("x")(1)("request_season")
|
||||
res(arrayRow, 22) = json("x")(1)("request_month")
|
||||
res(arrayRow, 23) = json("x")(1)("promo")
|
||||
res(arrayRow, 24) = json("x")(1)("value_loc")
|
||||
res(arrayRow, 25) = json("x")(1)("value_usd")
|
||||
res(arrayRow, 26) = json("x")(1)("cost_loc")
|
||||
res(arrayRow, 27) = json("x")(1)("cost_usd")
|
||||
res(arrayRow, 28) = json("x")(1)("units")
|
||||
res(arrayRow, 29) = json("x")(1)("version")
|
||||
res(arrayRow, 30) = json("x")(1)("iter")
|
||||
res(arrayRow, 31) = json("x")(1)("logid")
|
||||
res(arrayRow, 32) = json("x")(1)("tag")
|
||||
res(arrayRow, 33) = json("x")(1)("comment")
|
||||
res(arrayRow, 34) = json("x")(1)("pounds")
|
||||
json("x").Remove 1
|
||||
arrayRow = arrayRow + 1
|
||||
If jsonRow Mod batchSize = 0 Or json("x").Count = 0 Then
|
||||
Application.StatusBar = "Populating spreadsheet: " & Format(jsonRow, "#,##0") & " of " & Format(totalRows, "#,##0") & " rows..."
|
||||
Call Utils.SHTp_DumpVar(res, shData.Name, sheetRow, 1, False, True, True)
|
||||
sheetRow = sheetRow + batchSize
|
||||
End If
|
||||
jsonRow = jsonRow + 1
|
||||
Loop
|
||||
|
||||
Set json = Nothing
|
||||
Application.StatusBar = False
|
||||
End Sub
|
||||
|
||||
Sub pull_rep()
|
||||
|
||||
openf.Show
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
@ -206,46 +237,50 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim str() As String
|
||||
|
||||
|
||||
If doc = "" Then
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
'update timestamp
|
||||
Set json = JsonConverter.ParseJson(doc)
|
||||
'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
|
||||
'doc = JsonConverter.ConvertToJson(doc)
|
||||
|
||||
|
||||
server = shConfig.Range("server").Value
|
||||
|
||||
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
.Open "POST", server & "/" & json("type"), True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
Debug.Print "GET /"; json("type"); " (";
|
||||
Dim t As Single
|
||||
t = Timer
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
Debug.Print Timer - t; "sec): "; Left(wr, 200)
|
||||
End With
|
||||
|
||||
|
||||
If Mid(wr, 2, 5) = "error" Then
|
||||
MsgBox (wr)
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
If Mid(wr, 1, 6) = "<body>" Then
|
||||
MsgBox (wr)
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
If Mid(wr, 1, 6) = "<!DOCT" Then
|
||||
MsgBox (wr)
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
If Mid(wr, 1, 6) = "null" Then
|
||||
MsgBox ("API route not implemented")
|
||||
fail = True
|
||||
@ -253,15 +288,15 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
||||
End If
|
||||
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
|
||||
|
||||
If IsNull(json("x")) Then
|
||||
MsgBox ("No adjustment was made.")
|
||||
fail = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
ReDim res(json("x").Count - 1, 34)
|
||||
|
||||
|
||||
For i = 0 To UBound(res, 1)
|
||||
res(i, 0) = json("x")(i + 1)("bill_cust_descr")
|
||||
res(i, 1) = json("x")(i + 1)("billto_group")
|
||||
@ -299,11 +334,11 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
||||
res(i, 33) = json("x")(i + 1)("comment")
|
||||
res(i, 34) = json("x")(i + 1)("pounds")
|
||||
Next i
|
||||
|
||||
|
||||
Set json = Nothing
|
||||
|
||||
ReDim str(UBound(res, 1), UBound(res, 2))
|
||||
|
||||
|
||||
' For i = 0 To UBound(res, 1)
|
||||
' For j = 0 To UBound(res, 2)
|
||||
' If IsNull(res(i, j)) Then
|
||||
@ -313,19 +348,19 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
||||
' End If
|
||||
' Next j
|
||||
' Next i
|
||||
|
||||
|
||||
i = 1
|
||||
Do Until shData.Cells(i, 1) = ""
|
||||
i = i + 1
|
||||
Loop
|
||||
|
||||
|
||||
Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)
|
||||
|
||||
|
||||
|
||||
|
||||
'Call Utils.SHTp_Dump(str, shData.Name, CLng(i), 1, False, False, 28, 29, 30, 31, 32)
|
||||
|
||||
|
||||
shOrders.PivotTables("ptOrders").PivotCache.Refresh
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Sub load_config()
|
||||
@ -356,7 +391,7 @@ Sub load_config()
|
||||
End With
|
||||
'---plan version--------------------------------------------------------------
|
||||
handler.plan = shConfig.Range("budget").Value
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
@ -364,12 +399,12 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
Dim j As Object
|
||||
Dim i As Integer
|
||||
Dim r As Long
|
||||
|
||||
|
||||
With shMonthUpdate
|
||||
|
||||
|
||||
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
||||
.Cells(1, 16) = JsonConverter.ConvertToJson(j)
|
||||
|
||||
|
||||
For i = 1 To 12
|
||||
'------------volume-------------------
|
||||
.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
|
||||
@ -377,14 +412,14 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
.Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
|
||||
.Cells(i + 1, 4) = 0
|
||||
.Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
|
||||
|
||||
|
||||
'------------value----------------------
|
||||
.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
|
||||
.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
|
||||
.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
|
||||
.Cells(i + 1, 14) = 0
|
||||
.Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
|
||||
|
||||
|
||||
'-------------price----------------------
|
||||
If i > 0 Then
|
||||
'--prior--
|
||||
@ -393,7 +428,7 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
Else
|
||||
.Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
|
||||
End If
|
||||
|
||||
|
||||
'--base--
|
||||
If co_num(pkg(i, 2), 0) = 0 Then
|
||||
'if there is no monthly base volume,
|
||||
@ -411,17 +446,17 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
Else
|
||||
.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
|
||||
End If
|
||||
|
||||
|
||||
'--adjust--
|
||||
If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
|
||||
.Cells(i + 1, 8) = 0
|
||||
Else
|
||||
.Cells(i + 1, 8) = (Round(pkg(i, 7), 10) + Round(pkg(i, 6), 10)) / (Round(pkg(i, 3), 10) + Round(pkg(i, 2), 10)) - (Round(pkg(i, 6), 10) / Round(pkg(i, 2), 10))
|
||||
End If
|
||||
|
||||
|
||||
'--current adjust--
|
||||
.Cells(i + 1, 9) = 0
|
||||
|
||||
|
||||
'--forecast--
|
||||
If co_num(pkg(i, 4), 0) = 0 Then
|
||||
'if there is no monthly base volume,
|
||||
@ -439,18 +474,18 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
Else
|
||||
.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
|
||||
End If
|
||||
|
||||
|
||||
End If
|
||||
|
||||
|
||||
Next i
|
||||
|
||||
|
||||
'scenario
|
||||
.Range("R1:S1000").ClearContents
|
||||
For i = 0 To UBound(handler.sc, 1)
|
||||
.Cells(i + 1, 18) = handler.sc(i, 0)
|
||||
.Cells(i + 1, 19) = handler.sc(i, 1)
|
||||
Next i
|
||||
|
||||
|
||||
'basket
|
||||
.Range("U1:AC100000").ClearContents
|
||||
Call Utils.SHTp_DumpVar(basket, .Name, 1, 21, False, False, True)
|
||||
@ -458,11 +493,11 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
shConfig.Range("rebuild").Value = 0
|
||||
shConfig.Range("show_basket").Value = 0
|
||||
shConfig.Range("new_part").Value = 0
|
||||
|
||||
|
||||
shMonthView.LoadSheet
|
||||
|
||||
|
||||
End With
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
|
||||
@ -484,33 +519,37 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
|
||||
Dim i As Integer
|
||||
Dim j As Integer
|
||||
Dim res() As Variant
|
||||
|
||||
|
||||
If doc = "" Then
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
server = shConfig.Range("server").Value
|
||||
|
||||
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
.Open "GET", server & "/list_changes", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
Debug.Print "GET /list_changes (";
|
||||
Dim t As Single
|
||||
t = Timer
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
Debug.Print Timer - t; "sec): "; Left(wr, 200)
|
||||
End With
|
||||
|
||||
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
|
||||
|
||||
If IsNull(json("x")) Then
|
||||
MsgBox ("No history.")
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
ReDim res(json("x").Count - 1, 7)
|
||||
|
||||
|
||||
For i = 0 To UBound(res, 1)
|
||||
res(i, 0) = json("x")(i + 1)("user")
|
||||
res(i, 1) = json("x")(i + 1)("quota_rep_descr")
|
||||
@ -521,7 +560,7 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
|
||||
res(i, 6) = json("x")(i + 1)("id")
|
||||
res(i, 7) = json("x")(i + 1)("doc")
|
||||
Next i
|
||||
|
||||
|
||||
list_changes = res
|
||||
|
||||
End Function
|
||||
@ -536,25 +575,29 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant(
|
||||
Dim res() As Variant
|
||||
Dim doc As String
|
||||
Dim ds As Worksheet
|
||||
|
||||
|
||||
doc = "{""logid"":" & logid & "}"
|
||||
|
||||
|
||||
server = handler.server
|
||||
|
||||
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
.Open "GET", server & "/undo_change", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
Debug.Print "GET /undo_change (";
|
||||
Dim t As Single
|
||||
t = Timer
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
Debug.Print Timer - t; "sec): "; Left(wr, 200)
|
||||
End With
|
||||
|
||||
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
logid = json("x")(1)("id")
|
||||
|
||||
|
||||
'---------loop through and get a list of each row that needs deleted?-----
|
||||
|
||||
|
||||
j = 0
|
||||
For i = 1 To 100
|
||||
If shData.Cells(1, i) = "logid" Then
|
||||
@ -562,13 +605,13 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant(
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
|
||||
|
||||
If j = 0 Then
|
||||
MsgBox ("Current data set is not tracking changes. Cannot isolate change locally.")
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
i = 2
|
||||
With shData
|
||||
While .Cells(i, 1) <> ""
|
||||
@ -597,40 +640,47 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
|
||||
Dim i As Integer
|
||||
Dim j As Integer
|
||||
Dim res() As Variant
|
||||
|
||||
|
||||
If doc = "" Then
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
server = shConfig.Range("server").Value
|
||||
|
||||
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
.Open "GET", server & "/swap_fit", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
Debug.Print "GET /swap_fit (";
|
||||
Dim t As Single
|
||||
t = Timer
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
Debug.Print Timer - t; "sec): "; Left(wr, 200)
|
||||
End With
|
||||
|
||||
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
|
||||
|
||||
If IsNull(json("x")) Then
|
||||
MsgBox ("No history.")
|
||||
fail = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
ReDim res(json("x").Count - 1, 3)
|
||||
|
||||
|
||||
For i = 0 To UBound(res, 1)
|
||||
res(i, 0) = json("x")(i + 1)("part")
|
||||
res(i, 1) = json("x")(i + 1)("value_usd")
|
||||
res(i, 2) = json("x")(i + 1)("swap")
|
||||
res(i, 3) = json("x")(i + 1)("fit")
|
||||
Next i
|
||||
|
||||
|
||||
get_swap_fit = res
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,10 +1,10 @@
|
||||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf
|
||||
Caption = "Open a Forecast"
|
||||
ClientHeight = 1365
|
||||
ClientHeight = 2400
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 6825
|
||||
ClientWidth = 8220.001
|
||||
OleObjectBlob = "openf.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
@ -14,27 +14,44 @@ Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Private Sub cbCancel_Click()
|
||||
|
||||
openf.Hide
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cbOK_Click()
|
||||
|
||||
Application.StatusBar = "Retrieving data for " & cbDSM.Value & "....."
|
||||
|
||||
openf.Caption = "Retrieving data......"
|
||||
Call handler.pg_main_workset(cbDSM.Value)
|
||||
If opDSM.Value Then
|
||||
Call handler.pg_main_workset("quota_rep_descr", cbDSM.Value)
|
||||
ElseIf opDirector.Value Then
|
||||
Call handler.pg_main_workset("director", cbDirector.Value)
|
||||
ElseIf opSegment.Value Then
|
||||
Call handler.pg_main_workset("segm", cbSegment.Value)
|
||||
End If
|
||||
shOrders.PivotTables("ptOrders").PivotCache.Refresh
|
||||
Application.StatusBar = False
|
||||
openf.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub opDSM_Click()
|
||||
cbDSM.Enabled = True
|
||||
cbDirector.Enabled = False
|
||||
cbSegment.Enabled = False
|
||||
End Sub
|
||||
|
||||
Private Sub opDirector_Click()
|
||||
cbDSM.Enabled = False
|
||||
cbDirector.Enabled = True
|
||||
cbSegment.Enabled = False
|
||||
End Sub
|
||||
|
||||
Private Sub opSegment_Click()
|
||||
cbDSM.Enabled = False
|
||||
cbDirector.Enabled = False
|
||||
cbSegment.Enabled = True
|
||||
End Sub
|
||||
|
||||
Private Sub UserForm_Activate()
|
||||
|
||||
handler.server = shConfig.Range("server").Value
|
||||
cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.Value
|
||||
|
||||
cbDirector.list = shConfig.ListObjects("DIRECTORS").DataBodyRange.Value
|
||||
cbSegment.list = shConfig.ListObjects("SEGMENTS").DataBodyRange.Value
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
BIN
VBA/openf.frx
BIN
VBA/openf.frx
Binary file not shown.
BIN
VBA/part.frx
BIN
VBA/part.frx
Binary file not shown.
26
index.js
26
index.js
@ -75,14 +75,30 @@ server.get('/test_sql', function(req, res) {
|
||||
server.get('/get_pool', bodyParser.json(), function(req, res) {
|
||||
|
||||
var sql = "";
|
||||
var args = [req.body.quota_rep];
|
||||
var w = "";
|
||||
var c = 1;
|
||||
var d = 1;
|
||||
var args = [];
|
||||
var path = './route_sql/get_pool.sql';
|
||||
console.log(`${new Date().toISOString()}: GET /get_pool (Get all data for one DSM.)... SQL: ${path} ${"-._.".repeat(20)}`);
|
||||
|
||||
var callback = function(arg) {
|
||||
sql = arg;
|
||||
console.log(req.body.quota_rep);
|
||||
sql = sql.replace("rep_replace", req.body.quota_rep);
|
||||
|
||||
if (req.body.quota_rep) {
|
||||
// ensure backward compatibility
|
||||
console.log('Converting old format...', req.body);
|
||||
req.body = {'scenario':{'quota_rep_descr':req.body.quota_rep}};
|
||||
}
|
||||
|
||||
({ c, w, d } = build_where(req, c, w, d, args));
|
||||
|
||||
if (c == 1) {
|
||||
res.send("no body was sent");
|
||||
return;
|
||||
}
|
||||
console.log(req.body);
|
||||
sql = sql.replace(new RegExp("where_clause", 'g'), w);
|
||||
console.log(sql);
|
||||
Postgres.FirstRow(sql, [], res)
|
||||
};
|
||||
@ -668,8 +684,8 @@ server.post('/new_basket', bodyParser.json(), function(req, res) {
|
||||
|
||||
function build_where(req, c, w, d, args) {
|
||||
for (var i in req.body.scenario) {
|
||||
//console.log(i);
|
||||
///console.log(req.body[i]);
|
||||
// console.log(i);
|
||||
// console.log(req.body[i]);
|
||||
if (c > 1) {
|
||||
w = w +
|
||||
`
|
||||
|
||||
@ -45,7 +45,7 @@ SELECT
|
||||
FROM
|
||||
rlarp.osm_pool
|
||||
WHERE
|
||||
quota_rep_descr = 'rep_replace'
|
||||
where_clause
|
||||
GROUP BY
|
||||
---------customer info-----------------
|
||||
bill_cust_descr
|
||||
|
||||
Loading…
Reference in New Issue
Block a user