add functionality to display basket
This commit is contained in:
Trowbridge
parent
e7071a777c
commit
9b8a486981
182
TheBigOne.cls
182
TheBigOne.cls
@ -16,7 +16,7 @@ Public ADOo_errstring As String
|
||||
Public Enum ADOinterface
|
||||
MicrosoftJetOLEDB4 = 0
|
||||
MicrosoftACEOLEDB12 = 1
|
||||
SQLServer = 2
|
||||
SqlServer = 2
|
||||
SQLServerNativeClient = 3
|
||||
SQLServerNativeClient10 = 4
|
||||
OracleODBC = 5
|
||||
@ -28,7 +28,7 @@ End Enum
|
||||
|
||||
Public Enum SQLsyntax
|
||||
Db2 = 0
|
||||
SQLServer = 1
|
||||
SqlServer = 1
|
||||
PostgreSQL = 2
|
||||
End Enum
|
||||
|
||||
@ -396,7 +396,33 @@ Sub SHTp_Dump(ByRef tbl() As String, ByRef sheet As String, ByRef row As Long, B
|
||||
If clear Then sh.Cells.clear
|
||||
If transpose Then Call Me.ARRAYp_Transpose(tbl)
|
||||
|
||||
sh.range(sh.Cells(row, col).Address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).Address).FormulaR1C1 = tbl
|
||||
sh.Range(sh.Cells(row, col).Address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).Address).FormulaR1C1 = tbl
|
||||
|
||||
On Error GoTo errhndl
|
||||
|
||||
If UBound(NumFields()) <> -1 Then
|
||||
Dim i As Integer
|
||||
i = 0
|
||||
For i = 0 To UBound(NumFields())
|
||||
Call sh.Columns(NumFields(i) + 1).TextToColumns
|
||||
Next i
|
||||
End If
|
||||
|
||||
errhndl:
|
||||
If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub SHTp_DumpVar(ByRef tbl() As Variant, ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef clear As Boolean, ByRef transpose As Boolean, ParamArray NumFields())
|
||||
|
||||
Dim sh As Worksheet
|
||||
Set sh = Sheets(sheet)
|
||||
|
||||
'If clear Then sh.Cells.clear
|
||||
'If transpose Then Call Me.ARRAYp_Transpose(tbl)
|
||||
|
||||
sh.Range(sh.Cells(row, col).Address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).Address).FormulaR1C1 = tbl
|
||||
|
||||
On Error GoTo errhndl
|
||||
|
||||
@ -416,19 +442,19 @@ End Sub
|
||||
|
||||
Sub ARRAYp_Transpose(ByRef a() As String)
|
||||
|
||||
Dim s() As String
|
||||
ReDim s(UBound(a, 2), UBound(a, 1))
|
||||
Dim S() As String
|
||||
ReDim S(UBound(a, 2), UBound(a, 1))
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
|
||||
For i = 0 To UBound(s, 1)
|
||||
For j = 0 To UBound(s, 2)
|
||||
s(i, j) = a(j, i)
|
||||
For i = 0 To UBound(S, 1)
|
||||
For j = 0 To UBound(S, 2)
|
||||
S(i, j) = a(j, i)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
a = s
|
||||
a = S
|
||||
|
||||
End Sub
|
||||
|
||||
@ -473,6 +499,7 @@ errhdnl:
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Public Sub TBLp_FilterSingle(ByRef table() As String, ByRef column As Long, ByVal Filter As String, ByVal Equals As Boolean)
|
||||
|
||||
|
||||
@ -529,8 +556,8 @@ Function SQLp_RollingMonthList(ByRef mmmyy As String, ByRef outformat As String,
|
||||
|
||||
Dim i As Integer
|
||||
|
||||
cmn = Format(DateValue(Left(mmmyy, 3) & "-01-" & Right(mmmyy, 2)), "m")
|
||||
cy = Right(mmmyy, 2)
|
||||
cmn = Format(DateValue(left(mmmyy, 3) & "-01-" & right(mmmyy, 2)), "m")
|
||||
cy = right(mmmyy, 2)
|
||||
|
||||
For i = 0 To monthcount - 1
|
||||
If i <> 0 Then mlist = mlist & ","
|
||||
@ -554,21 +581,21 @@ Sub TBLp_DeleteCols(ByRef tbl() As String, ByRef column() As Integer)
|
||||
Dim j As Long
|
||||
Dim m As Long
|
||||
Dim k As Long
|
||||
Dim OK As Boolean
|
||||
Dim ok As Boolean
|
||||
|
||||
m = -1
|
||||
i = 0
|
||||
While i <= UBound(tbl, 1)
|
||||
k = 0
|
||||
OK = True
|
||||
ok = True
|
||||
Do While k <= UBound(column())
|
||||
If i = column(k) Then
|
||||
OK = False
|
||||
ok = False
|
||||
Exit Do
|
||||
End If
|
||||
k = k + 1
|
||||
Loop
|
||||
If OK = True Then
|
||||
If ok = True Then
|
||||
m = m + 1
|
||||
j = 0
|
||||
While j <= UBound(tbl, 2)
|
||||
@ -1301,7 +1328,7 @@ Public Function MISCe_CompareDate(ByRef base As Date, ByRef compare As Date) As
|
||||
|
||||
End Function
|
||||
|
||||
Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef range As Long, ByRef match As Boolean, ParamArray fldsvals()) As Long
|
||||
Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef Range As Long, ByRef match As Boolean, ParamArray fldsvals()) As Long
|
||||
|
||||
On Error GoTo errpath
|
||||
'has to be a lexicographically sorted table otherwise this evaluaiton will not be the same as the sort evaluaiton
|
||||
@ -1371,7 +1398,7 @@ Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef range As Long, By
|
||||
j = currow
|
||||
End If
|
||||
|
||||
range = i
|
||||
Range = i
|
||||
ROWe_FindOnSorted = j
|
||||
match = True
|
||||
Exit Function
|
||||
@ -1403,13 +1430,13 @@ End Function
|
||||
Public Function ROWp_CreateKey(ByRef tbl() As String, ByRef flds() As Integer, ByRef row As Long) As String
|
||||
|
||||
Dim i As Integer
|
||||
Dim s As String
|
||||
Dim S As String
|
||||
|
||||
For i = 0 To UBound(flds)
|
||||
s = s & tbl(flds(i), row)
|
||||
S = S & tbl(flds(i), row)
|
||||
Next i
|
||||
|
||||
ROWp_CreateKey = s
|
||||
ROWp_CreateKey = S
|
||||
|
||||
End Function
|
||||
|
||||
@ -1438,7 +1465,7 @@ Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITL
|
||||
MsgB.Caption = TITLE
|
||||
MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
|
||||
MsgB.Show
|
||||
MISC_msgbox_cancel = MsgB.Cancel
|
||||
MISC_msgbox_cancel = MsgB.cancel
|
||||
Application.EnableCancelKey = xlInterrupt
|
||||
|
||||
End Function
|
||||
@ -1594,7 +1621,7 @@ Sub SHTp_HyperlinkConvert(ByRef sheet As Worksheet, ByRef column As Integer, ByR
|
||||
Set sh = sheet
|
||||
i = startrow
|
||||
Do Until sh.Cells(i, column) = stopflag
|
||||
Call sh.Hyperlinks.Add(sh.range(sh.Cells(i, column).Address), sh.Cells(i, column))
|
||||
Call sh.Hyperlinks.Add(sh.Range(sh.Cells(i, column).Address), sh.Cells(i, column))
|
||||
i = i + 1
|
||||
Loop
|
||||
|
||||
@ -1957,7 +1984,7 @@ Function TXTp_ParseCSVrow(ByRef csv() As String, row As Long, col As Integer) As
|
||||
End Function
|
||||
|
||||
|
||||
Function json_from_list(keys As range, values As range) As String
|
||||
Function json_from_list(keys As Range, values As Range) As String
|
||||
|
||||
Dim json As String
|
||||
Dim i As Integer
|
||||
@ -1986,7 +2013,7 @@ Function json_from_list(keys As range, values As range) As String
|
||||
|
||||
End Function
|
||||
|
||||
Function json_concat(list As range) As String
|
||||
Function json_concat(list As Range) As String
|
||||
|
||||
Dim json As String
|
||||
Dim i As Integer
|
||||
@ -2009,7 +2036,7 @@ Function json_concat(list As range) As String
|
||||
|
||||
End Function
|
||||
|
||||
Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
|
||||
Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
|
||||
|
||||
|
||||
Dim i As Long
|
||||
@ -2017,7 +2044,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
|
||||
Dim sql As String
|
||||
Dim rec As String
|
||||
|
||||
sql = "INSERT INTO " & Target & " VALUES " & vbCrLf
|
||||
sql = "INSERT INTO " & target & " VALUES " & vbCrLf
|
||||
For i = start To ending
|
||||
rec = ""
|
||||
If i <> start Then sql = sql & "," & vbCrLf
|
||||
@ -2142,7 +2169,7 @@ Public Function MISCe_MaxLng(ByRef base As Long, ByRef compare As Long) As Long
|
||||
|
||||
End Function
|
||||
|
||||
Public Function markdown_from_table(ByRef tbl() As Variant) As String
|
||||
Public Function markdown_from_table(ByRef tbl() As Variant, Optional number_format As String) As String
|
||||
|
||||
|
||||
|
||||
@ -2163,6 +2190,7 @@ Public Function markdown_from_table(ByRef tbl() As Variant) As String
|
||||
'---build markdown table-----------
|
||||
For r = 1 To UBound(tbl, 1)
|
||||
If r = 2 Then
|
||||
'If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
|
||||
md = md & "|"
|
||||
For c = 1 To UBound(tbl, 2)
|
||||
md = md & "---" & String(Me.MISCe_MaxInt(msl(c), 3) - 3, "-") & "|"
|
||||
@ -2180,9 +2208,10 @@ Public Function markdown_from_table(ByRef tbl() As Variant) As String
|
||||
|
||||
End Function
|
||||
|
||||
Public Function json_multirange(ByRef r As range) As String
|
||||
|
||||
Dim ar As range
|
||||
Public Function json_multirange(ByRef r As Range) As String
|
||||
|
||||
Dim ar As Range
|
||||
Dim r1() As Variant
|
||||
Dim r2() As Variant
|
||||
Dim rslt As String
|
||||
@ -2216,7 +2245,7 @@ Function markdown_whole_sheet(ByRef sh As Worksheet) As String
|
||||
Dim x As New TheBigOne
|
||||
Dim tbl() As Variant
|
||||
|
||||
tbl = sh.range("A1:CZ1000").FormulaR1C1
|
||||
tbl = sh.Range("A1:CZ1000").FormulaR1C1
|
||||
|
||||
For ic = 1 To UBound(tbl, 2)
|
||||
For ir = 1 To UBound(tbl, 1)
|
||||
@ -2227,13 +2256,13 @@ Function markdown_whole_sheet(ByRef sh As Worksheet) As String
|
||||
Next ir
|
||||
Next ic
|
||||
|
||||
tbl = sh.range(sh.Cells(1, 1).Address & ":" & sh.Cells(mr, mc).Address).FormulaR1C1
|
||||
tbl = sh.Range(sh.Cells(1, 1).Address & ":" & sh.Cells(mr, mc).Address).FormulaR1C1
|
||||
|
||||
markdown_whole_sheet = Me.markdown_from_table(tbl)
|
||||
|
||||
End Function
|
||||
|
||||
Function MISCe_colnum_to_letter(ByRef x As Long) As String
|
||||
Function MISCe_col_to_letter(ByRef x As Long) As String
|
||||
|
||||
If x > 26 Then
|
||||
MISCe_colnum_to_letter = Chr(x \ 26 + 64) & Chr((x / 26 - x \ 26) * 26 + 64)
|
||||
@ -2243,6 +2272,7 @@ Function MISCe_colnum_to_letter(ByRef x As Long) As String
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, headers As Boolean, syntax As SQLsyntax) As String
|
||||
|
||||
|
||||
@ -2333,7 +2363,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
||||
Select Case syntax
|
||||
Case SQLsyntax.Db2
|
||||
sql = "SELECT * FROM TABLE( VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
||||
Case SQLsyntax.SQLServer
|
||||
Case SQLsyntax.SqlServer
|
||||
sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
||||
Case SQLsyntax.PostgreSQL
|
||||
sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
||||
@ -2345,7 +2375,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
||||
|
||||
End Function
|
||||
|
||||
Public Function ARRAYp_get_range_string(ByRef r As range) As String()
|
||||
Public Function ARRAYp_get_range_string(ByRef r As Range) As String()
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
@ -2374,3 +2404,87 @@ Public Function ARRAYp_get_range_string(ByRef r As range) As String()
|
||||
|
||||
End Function
|
||||
|
||||
Public Function TBLp_range(ByRef dump() As Variant, ByVal upperleft As Range) As Range
|
||||
|
||||
width As Long
|
||||
width = UBound(dump, 2)
|
||||
Dim newcol As String
|
||||
newcol = ConvertBase10(upperleft.column + UBound(dump, 2), "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As String) As String
|
||||
'credit: http://www.freevbcode.com/ShowCode.asp?ID=6604
|
||||
|
||||
Dim S As String, tmp As Double, i As Integer, lastI As Integer
|
||||
Dim BaseSize As Integer
|
||||
BaseSize = Len(sNewBaseDigits)
|
||||
Do While val(d) <> 0
|
||||
tmp = d
|
||||
i = 0
|
||||
Do While tmp >= BaseSize
|
||||
i = i + 1
|
||||
tmp = tmp / BaseSize
|
||||
Loop
|
||||
If i <> lastI - 1 And lastI <> 0 Then S = S & String(lastI - i - 1, left(sNewBaseDigits, 1)) 'get the zero digits inside the number
|
||||
tmp = Int(tmp) 'truncate decimals
|
||||
S = S + Mid(sNewBaseDigits, tmp + 1, 1)
|
||||
d = d - tmp * (BaseSize ^ i)
|
||||
lastI = i
|
||||
Loop
|
||||
S = S & String(i, left(sNewBaseDigits, 1)) 'get the zero digits at the end of the number
|
||||
Misc_ConvBase10 = S
|
||||
End Function
|
||||
|
||||
Public Function SHTp_get_block(point As Range) As Variant()
|
||||
|
||||
Dim left As Long
|
||||
Dim right As Long
|
||||
Dim top As Long
|
||||
Dim bot As Long
|
||||
Dim i As Long
|
||||
Dim lcol As String
|
||||
Dim rcol As String
|
||||
Dim r As Range
|
||||
|
||||
|
||||
i = 0
|
||||
Do Until point.Worksheet.Cells(point.row, point.column + i) = ""
|
||||
i = i + 1
|
||||
Loop
|
||||
If i <> 0 Then i = i - 1
|
||||
right = point.column + i
|
||||
|
||||
i = 0
|
||||
Do Until point.Worksheet.Cells(point.row, point.column + i) = ""
|
||||
i = i - 1
|
||||
Loop
|
||||
If i <> 0 Then i = i + 1
|
||||
left = point.column + i
|
||||
|
||||
i = 0
|
||||
Do Until point.Worksheet.Cells(point.row + i, point.column) = ""
|
||||
i = i + 1
|
||||
Loop
|
||||
If i <> 0 Then i = i - 1
|
||||
bot = point.row + i
|
||||
|
||||
i = 0
|
||||
Do Until point.Worksheet.Cells(point.row + i, point.column) = ""
|
||||
i = i - 1
|
||||
If point.row + i < 1 Then Exit Do
|
||||
Loop
|
||||
If i <> 0 Then i = i + 1
|
||||
top = point.row + i
|
||||
|
||||
lcol = Me.Misc_ConvBase10(left - 1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||
rcol = Me.Misc_ConvBase10(right - 1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||
|
||||
Set r = Worksheets("_month").Range(lcol & top & ":" & rcol & bot)
|
||||
SHTp_get_block = r
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
37
fpvt.frm
37
fpvt.frm
@ -23,6 +23,7 @@ Private clear_lb As Boolean
|
||||
Private load_tb As Boolean
|
||||
Private set_Price As Boolean
|
||||
Private sp As Object
|
||||
Private basket() As Variant
|
||||
|
||||
Private bVol As Double
|
||||
Private bVal As Double
|
||||
@ -366,7 +367,41 @@ Private Sub UserForm_Activate()
|
||||
month(0, 8) = "2020 val"
|
||||
|
||||
Me.crunch_array
|
||||
Call handler.month_tosheet(month)
|
||||
|
||||
ReDim basket(sp("package")("basket").Count, 4)
|
||||
|
||||
' basket(0, 0) = "order_season"
|
||||
' basket(0, 1) = "order_month"
|
||||
' basket(0, 2) = "version"
|
||||
' basket(0, 3) = "iter"
|
||||
' basket(0, 4) = "part_descr"
|
||||
' basket(0, 5) = "bill_cust_descr"
|
||||
' basket(0, 6) = "ship_cust_descr"
|
||||
' basket(0, 7) = "units"
|
||||
' basket(0, 8) = "value_usd"
|
||||
basket(0, 0) = "part_descr"
|
||||
basket(0, 1) = "bill_cust_descr"
|
||||
basket(0, 2) = "ship_cust_descr"
|
||||
basket(0, 3) = "mix"
|
||||
|
||||
|
||||
For i = 1 To UBound(basket, 1)
|
||||
'basket(i, 0) = sp("package")("base")(i)("order_season")
|
||||
'basket(i, 1) = sp("package")("base")(i)("order_month")
|
||||
'basket(i, 2) = sp("package")("base")(i)("version")
|
||||
'basket(i, 3) = sp("package")("base")(i)("iter")
|
||||
'basket(i, 4) = sp("package")("base")(i)("part_descr")
|
||||
'basket(i, 5) = sp("package")("base")(i)("bill_cust_descr")
|
||||
'basket(i, 6) = sp("package")("base")(i)("ship_cust_descr")
|
||||
'basket(i, 7) = sp("package")("base")(i)("units")
|
||||
'basket(i, 8) = sp("package")("base")(i)("value_usd")
|
||||
basket(i, 0) = sp("package")("basket")(i)("part_descr")
|
||||
basket(i, 1) = sp("package")("basket")(i)("bill_cust_descr")
|
||||
basket(i, 2) = sp("package")("basket")(i)("ship_cust_descr")
|
||||
basket(i, 3) = sp("package")("basket")(i)("mix")
|
||||
Next i
|
||||
|
||||
Call handler.month_tosheet(month, basket)
|
||||
Application.StatusBar = False
|
||||
|
||||
End Sub
|
||||
|
||||
22
handler.bas
22
handler.bas
@ -52,6 +52,7 @@ Function scenario_package(doc As String, ByRef status As Boolean) As Object
|
||||
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
|
||||
@ -334,10 +335,11 @@ Sub load_config()
|
||||
|
||||
End Sub
|
||||
|
||||
Sub month_tosheet(ByRef pkg() As Variant)
|
||||
Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
|
||||
Dim j As Object
|
||||
Dim i As Integer
|
||||
Dim r As Long
|
||||
Dim sh As Worksheet
|
||||
Set sh = Sheets("_month")
|
||||
|
||||
@ -406,12 +408,24 @@ Sub month_tosheet(ByRef pkg() As Variant)
|
||||
sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
|
||||
End If
|
||||
|
||||
'--json--
|
||||
|
||||
End If
|
||||
|
||||
Next i
|
||||
|
||||
'scenario
|
||||
For i = 0 To UBound(handler.sc, 1)
|
||||
sh.Cells(i + 1, 18) = handler.sc(i, 0)
|
||||
sh.Cells(i + 1, 19) = handler.sc(i, 1)
|
||||
Next i
|
||||
|
||||
'basket
|
||||
sh.Range("U1:Y100000").ClearContents
|
||||
For i = 0 To UBound(basket, 2)
|
||||
For r = 0 To UBound(basket, 1)
|
||||
sh.Cells(r + 1, i + 21) = basket(r, i)
|
||||
Next r
|
||||
Next i
|
||||
|
||||
months.load_sheet
|
||||
|
||||
End Sub
|
||||
@ -425,3 +439,5 @@ Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
66
months.cls
66
months.cls
@ -22,6 +22,8 @@ Private adjust() As Object
|
||||
Private jtext() As Variant
|
||||
Private basejson As Object
|
||||
Private rollback As Boolean
|
||||
Private scenario() As Variant
|
||||
Private orig As Range
|
||||
|
||||
|
||||
|
||||
@ -38,6 +40,8 @@ Private Sub Worksheet_Change(ByVal target As Range)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
|
||||
If Not Intersect(target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
|
||||
@ -63,7 +67,11 @@ Sub mvp_set()
|
||||
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
||||
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
|
||||
sales(i, 5) = units(i, 5) * price(i, 5)
|
||||
If units(i, 4) = 0 And price(i, 4) = 0 Then
|
||||
sales(i, 4) = 0
|
||||
Else
|
||||
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
||||
End If
|
||||
Call Me.build_json(i)
|
||||
Next i
|
||||
|
||||
@ -84,7 +92,11 @@ Sub mvp_adj()
|
||||
units(i, 5) = units(i, 4) + (units(i, 2) + units(i, 3))
|
||||
price(i, 5) = price(i, 4) + (price(i, 2) + price(i, 3))
|
||||
sales(i, 5) = units(i, 5) * price(i, 5)
|
||||
If units(i, 4) = 0 And price(i, 4) = 0 Then
|
||||
sales(i, 4) = 0
|
||||
Else
|
||||
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
||||
End If
|
||||
Call Me.build_json(i)
|
||||
Next i
|
||||
|
||||
@ -102,6 +114,7 @@ Sub ms_set()
|
||||
vp = Sheets("month").Range("R2")
|
||||
|
||||
For i = 1 To 12
|
||||
If sales(i, 5) = "" Then sales(i, 5) = 0
|
||||
If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 6) <> Round(sales(i, 4), 6) Then
|
||||
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
||||
Select Case vp
|
||||
@ -154,6 +167,7 @@ Sub ms_adj()
|
||||
vp = Sheets("month").Range("R2")
|
||||
|
||||
For i = 1 To 12
|
||||
If sales(i, 4) = "" Then sales(i, 4) = 0
|
||||
If Round(sales(i, 5), 6) <> Round(sales(i, 2) + sales(i, 3) + sales(i, 4), 6) Then
|
||||
sales(i, 5) = sales(i, 4) + sales(i, 2) + sales(i, 3)
|
||||
Select Case vp
|
||||
@ -226,19 +240,29 @@ Sub set_sheet()
|
||||
Range("B18:F18").FormulaR1C1 = tunits
|
||||
Range("H18:L18").FormulaR1C1 = tprice
|
||||
Range("N18:R18").FormulaR1C1 = tsales
|
||||
Range("T6:U18").FormulaR1C1 = scenario
|
||||
|
||||
Sheets("month").Range("B32:Q5000").ClearContents
|
||||
|
||||
For i = 1 To 12
|
||||
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
|
||||
Next i
|
||||
|
||||
ActiveWindow.FreezePanes = False
|
||||
|
||||
Rows("19:32").Hidden = False
|
||||
|
||||
dumping = False
|
||||
|
||||
End Sub
|
||||
|
||||
Sub load_sheet()
|
||||
|
||||
|
||||
units = Sheets("_month").Range("A2:E13").FormulaR1C1
|
||||
price = Sheets("_month").Range("F2:J13").FormulaR1C1
|
||||
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
|
||||
scenario = Sheets("_month").Range("R1:S13").FormulaR1C1
|
||||
tunits = Range("B18:F18")
|
||||
tprice = Range("H18:L18")
|
||||
tsales = Range("N18:R18")
|
||||
@ -246,6 +270,8 @@ Sub load_sheet()
|
||||
Me.crunch_array
|
||||
Me.set_sheet
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub set_format()
|
||||
@ -369,7 +395,7 @@ End Sub
|
||||
Sub build_json(ByVal pos As Integer)
|
||||
|
||||
'if something is changing
|
||||
If Round(units(pos, 4), 2) <> 0 Or Round(price(pos, 4), 8) <> 0 Or Round(sales(pos, 4), 8) <> 0 Then
|
||||
If Round(units(pos, 4), 2) <> 0 Or (Round(price(pos, 4), 8) <> 0 And Round(units(pos, 5), 2) <> 0) Then
|
||||
Set adjust(pos) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
|
||||
'if there is no existing volume on the target month but units are being added
|
||||
If units(pos, 2) + units(pos, 3) = 0 And units(pos, 4) <> 0 Then
|
||||
@ -445,4 +471,42 @@ Sub reset()
|
||||
|
||||
Call Me.load_sheet
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub show_basket()
|
||||
|
||||
Dim i As Long
|
||||
Dim basket() As Variant
|
||||
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
|
||||
|
||||
dumping = True
|
||||
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
Set orig = Selection
|
||||
|
||||
ActiveWindow.FreezePanes = False
|
||||
|
||||
|
||||
For i = 1 To UBound(basket, 1) - 1
|
||||
Sheets("month").Cells(32 + i, 2) = basket(i + 1, 1)
|
||||
Sheets("month").Cells(32 + i, 6) = basket(i + 1, 2)
|
||||
Sheets("month").Cells(32 + i, 12) = basket(i + 1, 3)
|
||||
Sheets("month").Cells(32 + i, 17) = basket(i + 1, 4)
|
||||
Next i
|
||||
|
||||
Rows("20:20").Select
|
||||
ActiveWindow.FreezePanes = True
|
||||
|
||||
Rows("20:31").Select
|
||||
Selection.EntireRow.Hidden = True
|
||||
|
||||
orig.Select
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
dumping = False
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Loading…
Reference in New Issue
Block a user