work on editing basket
This commit is contained in:
parent
6a34f3fcf4
commit
a3d9512373
@ -396,7 +396,7 @@ Sub SHTp_Dump(ByRef tbl() As String, ByRef sheet As String, ByRef row As Long, B
|
|||||||
If clear Then sh.Cells.clear
|
If clear Then sh.Cells.clear
|
||||||
If transpose Then Call Me.ARRAYp_Transpose(tbl)
|
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
|
On Error GoTo errhndl
|
||||||
|
|
||||||
@ -414,25 +414,23 @@ errhndl:
|
|||||||
|
|
||||||
End Sub
|
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())
|
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, ByRef zerobase As Boolean)
|
||||||
|
|
||||||
Dim sh As Worksheet
|
Dim sh As Worksheet
|
||||||
|
Dim address As String
|
||||||
Set sh = Sheets(sheet)
|
Set sh = Sheets(sheet)
|
||||||
|
|
||||||
'If clear Then sh.Cells.clear
|
'If clear Then sh.Cells.clear
|
||||||
'If transpose Then Call Me.ARRAYp_Transpose(tbl)
|
'If transpose Then Call Me.ARRAYp_Transpose(tbl)
|
||||||
|
If zerobase Then
|
||||||
sh.Range(sh.Cells(row, col).Address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).Address).FormulaR1C1 = tbl
|
address = sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).address
|
||||||
|
Else
|
||||||
|
address = sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1) - 1, col + UBound(tbl, 2) - 1).address
|
||||||
|
End If
|
||||||
|
sh.Range(address).FormulaR1C1 = tbl
|
||||||
|
|
||||||
On Error GoTo errhndl
|
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:
|
errhndl:
|
||||||
If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
|
If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
|
||||||
@ -442,19 +440,19 @@ End Sub
|
|||||||
|
|
||||||
Sub ARRAYp_Transpose(ByRef a() As String)
|
Sub ARRAYp_Transpose(ByRef a() As String)
|
||||||
|
|
||||||
Dim S() As String
|
Dim s() As String
|
||||||
ReDim S(UBound(a, 2), UBound(a, 1))
|
ReDim s(UBound(a, 2), UBound(a, 1))
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
Dim j As Long
|
Dim j As Long
|
||||||
|
|
||||||
For i = 0 To UBound(S, 1)
|
For i = 0 To UBound(s, 1)
|
||||||
For j = 0 To UBound(S, 2)
|
For j = 0 To UBound(s, 2)
|
||||||
S(i, j) = a(j, i)
|
s(i, j) = a(j, i)
|
||||||
Next j
|
Next j
|
||||||
Next i
|
Next i
|
||||||
|
|
||||||
a = S
|
a = s
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
@ -1430,13 +1428,13 @@ End Function
|
|||||||
Public Function ROWp_CreateKey(ByRef tbl() As String, ByRef flds() As Integer, ByRef row As Long) As String
|
Public Function ROWp_CreateKey(ByRef tbl() As String, ByRef flds() As Integer, ByRef row As Long) As String
|
||||||
|
|
||||||
Dim i As Integer
|
Dim i As Integer
|
||||||
Dim S As String
|
Dim s As String
|
||||||
|
|
||||||
For i = 0 To UBound(flds)
|
For i = 0 To UBound(flds)
|
||||||
S = S & tbl(flds(i), row)
|
s = s & tbl(flds(i), row)
|
||||||
Next i
|
Next i
|
||||||
|
|
||||||
ROWp_CreateKey = S
|
ROWp_CreateKey = s
|
||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
@ -1621,7 +1619,7 @@ Sub SHTp_HyperlinkConvert(ByRef sheet As Worksheet, ByRef column As Integer, ByR
|
|||||||
Set sh = sheet
|
Set sh = sheet
|
||||||
i = startrow
|
i = startrow
|
||||||
Do Until sh.Cells(i, column) = stopflag
|
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
|
i = i + 1
|
||||||
Loop
|
Loop
|
||||||
|
|
||||||
@ -2036,7 +2034,7 @@ Function json_concat(list As Range) As String
|
|||||||
|
|
||||||
End Function
|
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
|
Dim i As Long
|
||||||
@ -2044,7 +2042,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, tri
|
|||||||
Dim sql As String
|
Dim sql As String
|
||||||
Dim rec As String
|
Dim rec As String
|
||||||
|
|
||||||
sql = "INSERT INTO " & target & " VALUES " & vbCrLf
|
sql = "INSERT INTO " & Target & " VALUES " & vbCrLf
|
||||||
For i = start To ending
|
For i = start To ending
|
||||||
rec = ""
|
rec = ""
|
||||||
If i <> start Then sql = sql & "," & vbCrLf
|
If i <> start Then sql = sql & "," & vbCrLf
|
||||||
@ -2256,7 +2254,7 @@ Function markdown_whole_sheet(ByRef sh As Worksheet) As String
|
|||||||
Next ir
|
Next ir
|
||||||
Next ic
|
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)
|
markdown_whole_sheet = Me.markdown_from_table(tbl)
|
||||||
|
|
||||||
@ -2418,7 +2416,7 @@ End Function
|
|||||||
Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As String) As String
|
Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As String) As String
|
||||||
'credit: http://www.freevbcode.com/ShowCode.asp?ID=6604
|
'credit: http://www.freevbcode.com/ShowCode.asp?ID=6604
|
||||||
|
|
||||||
Dim S As String, tmp As Double, i As Integer, lastI As Integer
|
Dim s As String, tmp As Double, i As Integer, lastI As Integer
|
||||||
Dim BaseSize As Integer
|
Dim BaseSize As Integer
|
||||||
BaseSize = Len(sNewBaseDigits)
|
BaseSize = Len(sNewBaseDigits)
|
||||||
Do While val(d) <> 0
|
Do While val(d) <> 0
|
||||||
@ -2428,14 +2426,14 @@ Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As Strin
|
|||||||
i = i + 1
|
i = i + 1
|
||||||
tmp = tmp / BaseSize
|
tmp = tmp / BaseSize
|
||||||
Loop
|
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
|
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
|
tmp = Int(tmp) 'truncate decimals
|
||||||
S = S + Mid(sNewBaseDigits, tmp + 1, 1)
|
s = s + Mid(sNewBaseDigits, tmp + 1, 1)
|
||||||
d = d - tmp * (BaseSize ^ i)
|
d = d - tmp * (BaseSize ^ i)
|
||||||
lastI = i
|
lastI = i
|
||||||
Loop
|
Loop
|
||||||
S = S & String(i, left(sNewBaseDigits, 1)) 'get the zero digits at the end of the number
|
s = s & String(i, left(sNewBaseDigits, 1)) 'get the zero digits at the end of the number
|
||||||
Misc_ConvBase10 = S
|
Misc_ConvBase10 = s
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function SHTp_get_block(point As Range) As Variant()
|
Public Function SHTp_get_block(point As Range) As Variant()
|
||||||
@ -2479,8 +2477,9 @@ Public Function SHTp_get_block(point As Range) As Variant()
|
|||||||
If i <> 0 Then i = i + 1
|
If i <> 0 Then i = i + 1
|
||||||
top = point.row + i
|
top = point.row + i
|
||||||
|
|
||||||
lcol = Me.Misc_ConvBase10(left - 1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
lcol = Me.ColumnLetter(left)
|
||||||
rcol = Me.Misc_ConvBase10(right - 1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
rcol = Me.ColumnLetter(right)
|
||||||
|
'point.row (right)
|
||||||
|
|
||||||
Set r = Worksheets("_month").Range(lcol & top & ":" & rcol & bot)
|
Set r = Worksheets("_month").Range(lcol & top & ":" & rcol & bot)
|
||||||
SHTp_get_block = r
|
SHTp_get_block = r
|
||||||
@ -2488,3 +2487,18 @@ Public Function SHTp_get_block(point As Range) As Variant()
|
|||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
|
||||||
|
Function ColumnLetter(ColumnNumber As Long) As String
|
||||||
|
Dim n As Long
|
||||||
|
Dim c As Byte
|
||||||
|
Dim s As String
|
||||||
|
|
||||||
|
n = ColumnNumber
|
||||||
|
Do
|
||||||
|
c = ((n - 1) Mod 26)
|
||||||
|
s = Chr(c + 65) & s
|
||||||
|
n = (n - c) \ 26
|
||||||
|
Loop While n > 0
|
||||||
|
ColumnLetter = s
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
||||||
|
77
build.frm
Normal file
77
build.frm
Normal file
@ -0,0 +1,77 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build
|
||||||
|
Caption = "UserForm1"
|
||||||
|
ClientHeight = 3015
|
||||||
|
ClientLeft = 120
|
||||||
|
ClientTop = 465
|
||||||
|
ClientWidth = 8100
|
||||||
|
OleObjectBlob = "build.frx":0000
|
||||||
|
StartUpPosition = 1 'CenterOwner
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "build"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
Public part As String
|
||||||
|
Public bill As String
|
||||||
|
Public ship As String
|
||||||
|
Public useval As Boolean
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||||
|
Select Case KeyCode
|
||||||
|
Case 13
|
||||||
|
useval = True
|
||||||
|
Me.Hide
|
||||||
|
Case 27
|
||||||
|
canel = False
|
||||||
|
Me.Hide
|
||||||
|
End Select
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||||
|
|
||||||
|
Select Case KeyCode
|
||||||
|
Case 13
|
||||||
|
useval = True
|
||||||
|
Me.Hide
|
||||||
|
Case 27
|
||||||
|
useval = False
|
||||||
|
Me.Hide
|
||||||
|
End Select
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub cbShip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||||
|
Select Case KeyCode
|
||||||
|
Case 13
|
||||||
|
useval = True
|
||||||
|
Me.Hide
|
||||||
|
Case 27
|
||||||
|
useval = False
|
||||||
|
Me.Hide
|
||||||
|
End Select
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub UserForm_Activate()
|
||||||
|
|
||||||
|
useval = False
|
||||||
|
|
||||||
|
cbPart.value = part
|
||||||
|
cbBill.value = bill
|
||||||
|
cbShip.value = ship
|
||||||
|
|
||||||
|
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
|
||||||
|
cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
|
||||||
|
cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
2
fpvt.frm
2
fpvt.frm
@ -368,7 +368,7 @@ Private Sub UserForm_Activate()
|
|||||||
|
|
||||||
Me.crunch_array
|
Me.crunch_array
|
||||||
|
|
||||||
ReDim basket(sp("package")("basket").Count, 4)
|
ReDim basket(sp("package")("basket").Count, 3)
|
||||||
|
|
||||||
' basket(0, 0) = "order_season"
|
' basket(0, 0) = "order_season"
|
||||||
' basket(0, 1) = "order_month"
|
' basket(0, 1) = "order_month"
|
||||||
|
@ -420,12 +420,9 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
|||||||
Next i
|
Next i
|
||||||
|
|
||||||
'basket
|
'basket
|
||||||
sh.Range("U1:Y100000").ClearContents
|
sh.Range("U1:AC100000").ClearContents
|
||||||
For i = 0 To UBound(basket, 2)
|
Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
|
||||||
For r = 0 To UBound(basket, 1)
|
Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
|
||||||
sh.Cells(r + 1, i + 21) = basket(r, i)
|
|
||||||
Next r
|
|
||||||
Next i
|
|
||||||
|
|
||||||
months.load_sheet
|
months.load_sheet
|
||||||
|
|
||||||
|
186
months.cls
186
months.cls
@ -24,30 +24,76 @@ Private basejson As Object
|
|||||||
Private rollback As Boolean
|
Private rollback As Boolean
|
||||||
Private scenario() As Variant
|
Private scenario() As Variant
|
||||||
Private orig As Range
|
Private orig As Range
|
||||||
|
Private basket_touch As Range
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub Worksheet_Change(ByVal target As Range)
|
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim b() As Variant
|
||||||
|
|
||||||
|
cancel = True
|
||||||
|
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing Then
|
||||||
|
build.part = Sheets("month").Cells(Target.row, 2)
|
||||||
|
build.bill = Sheets("month").Cells(Target.row, 6)
|
||||||
|
build.ship = Sheets("month").Cells(Target.row, 12)
|
||||||
|
build.useval = False
|
||||||
|
build.Show
|
||||||
|
|
||||||
|
If build.useval Then
|
||||||
|
dumping = True
|
||||||
|
'if an empty row is selected, force it to be the next open slot
|
||||||
|
If Sheets("month").Cells(Target.row, 2) = "" Then
|
||||||
|
Do Until Sheets("month").Cells(Target.row + i, 2) <> ""
|
||||||
|
i = i - 1
|
||||||
|
Loop
|
||||||
|
i = i + 1
|
||||||
|
End If
|
||||||
|
|
||||||
|
Sheets("month").Cells(Target.row + i, 2) = build.cbPart.value
|
||||||
|
Sheets("month").Cells(Target.row + i, 6) = build.cbBill.value
|
||||||
|
Sheets("month").Cells(Target.row + i, 12) = build.cbShip.value
|
||||||
|
'Sheets("month").Cells.Rows(Target.row + i).Select
|
||||||
|
dumping = False
|
||||||
|
Set basket_touch = Selection
|
||||||
|
Call Me.get_edit_basket
|
||||||
|
|
||||||
|
End If
|
||||||
|
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||||
|
|
||||||
|
|
||||||
If Not dumping Then
|
If Not dumping Then
|
||||||
|
|
||||||
If target.Columns.Count > 1 Then
|
If Not Intersect(Target, Range("A1:R18")) Is Nothing Then
|
||||||
MsgBox ("you can only change one column at a time - your change will be undone")
|
If Target.Columns.Count > 1 Then
|
||||||
dumping = True
|
MsgBox ("you can only change one column at a time - your change will be undone")
|
||||||
Application.Undo
|
dumping = True
|
||||||
dumping = False
|
Application.Undo
|
||||||
Exit Sub
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
If Not Intersect(target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
|
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("F6:F17")) Is Nothing Then Call Me.mvp_set
|
||||||
If Not Intersect(target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
|
If Not Intersect(Target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
|
||||||
If Not Intersect(target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set
|
If Not Intersect(Target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set
|
||||||
If Not Intersect(target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj
|
If Not Intersect(Target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj
|
||||||
If Not Intersect(target, Range("R6:R17")) Is Nothing Then Call Me.ms_set
|
If Not Intersect(Target, Range("R6:R17")) Is Nothing Then Call Me.ms_set
|
||||||
|
If Not Intersect(Target, Range("b33:q1000")) Is Nothing Then
|
||||||
|
Set basket_touch = Target
|
||||||
|
Call Me.get_edit_basket
|
||||||
|
End If
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
End If
|
End If
|
||||||
|
|
||||||
@ -243,7 +289,7 @@ Sub set_sheet()
|
|||||||
Range("T6:U18").ClearContents
|
Range("T6:U18").ClearContents
|
||||||
Range("T6:U18").FormulaR1C1 = scenario
|
Range("T6:U18").FormulaR1C1 = scenario
|
||||||
|
|
||||||
Sheets("month").Range("B32:Q5000").ClearContents
|
'Sheets("month").Range("B32:Q5000").ClearContents
|
||||||
|
|
||||||
For i = 1 To 12
|
For i = 1 To 12
|
||||||
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
|
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
|
||||||
@ -267,6 +313,8 @@ Sub load_sheet()
|
|||||||
tunits = Range("B18:F18")
|
tunits = Range("B18:F18")
|
||||||
tprice = Range("H18:L18")
|
tprice = Range("H18:L18")
|
||||||
tsales = Range("N18:R18")
|
tsales = Range("N18:R18")
|
||||||
|
'reset basket
|
||||||
|
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
|
||||||
ReDim adjust(12)
|
ReDim adjust(12)
|
||||||
Me.crunch_array
|
Me.crunch_array
|
||||||
Me.set_sheet
|
Me.set_sheet
|
||||||
@ -359,9 +407,9 @@ Sub set_border(ByRef targ As Range)
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub fill_yellow(ByRef target As Range)
|
Sub fill_yellow(ByRef Target As Range)
|
||||||
|
|
||||||
With target.Interior
|
With Target.Interior
|
||||||
.Pattern = xlSolid
|
.Pattern = xlSolid
|
||||||
.PatternColorIndex = xlAutomatic
|
.PatternColorIndex = xlAutomatic
|
||||||
.ThemeColor = xlThemeColorAccent4
|
.ThemeColor = xlThemeColorAccent4
|
||||||
@ -371,9 +419,9 @@ Sub fill_yellow(ByRef target As Range)
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub fill_none(ByRef target As Range)
|
Sub fill_none(ByRef Target As Range)
|
||||||
|
|
||||||
With target.Interior
|
With Target.Interior
|
||||||
.Pattern = xlNone
|
.Pattern = xlNone
|
||||||
.TintAndShade = 0
|
.TintAndShade = 0
|
||||||
.PatternTintAndShade = 0
|
.PatternTintAndShade = 0
|
||||||
@ -381,15 +429,15 @@ Sub fill_none(ByRef target As Range)
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub format_price(ByRef target As Range)
|
Sub format_price(ByRef Target As Range)
|
||||||
|
|
||||||
target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
Target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub format_number(ByRef target As Range)
|
Sub format_number(ByRef Target As Range)
|
||||||
|
|
||||||
target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
Target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
@ -483,31 +531,101 @@ Sub show_basket()
|
|||||||
|
|
||||||
dumping = True
|
dumping = True
|
||||||
|
|
||||||
Application.ScreenUpdating = False
|
'Application.ScreenUpdating = False
|
||||||
|
|
||||||
Set orig = Selection
|
'Set orig = Selection
|
||||||
|
|
||||||
ActiveWindow.FreezePanes = False
|
'ActiveWindow.FreezePanes = False
|
||||||
|
|
||||||
|
For i = 1 To UBound(basket, 1)
|
||||||
For i = 1 To UBound(basket, 1) - 1
|
|
||||||
Sheets("month").Cells(31 + i, 2) = basket(i, 1)
|
Sheets("month").Cells(31 + i, 2) = basket(i, 1)
|
||||||
Sheets("month").Cells(31 + i, 6) = basket(i, 2)
|
Sheets("month").Cells(31 + i, 6) = basket(i, 2)
|
||||||
Sheets("month").Cells(31 + i, 12) = basket(i, 3)
|
Sheets("month").Cells(31 + i, 12) = basket(i, 3)
|
||||||
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
|
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
|
||||||
Next i
|
Next i
|
||||||
|
|
||||||
Rows("20:20").Select
|
'Rows("20:20").Select
|
||||||
ActiveWindow.FreezePanes = True
|
'ActiveWindow.FreezePanes = True
|
||||||
|
|
||||||
Rows("20:31").Select
|
'Rows("20:31").Select
|
||||||
Selection.EntireRow.Hidden = True
|
'Selection.EntireRow.Hidden = True
|
||||||
|
Rows("20:31").Hidden = True
|
||||||
|
'orig.Select
|
||||||
|
|
||||||
orig.Select
|
'Application.ScreenUpdating = True
|
||||||
|
|
||||||
Application.ScreenUpdating = True
|
|
||||||
|
|
||||||
dumping = False
|
dumping = False
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
Sub part_list()
|
||||||
|
|
||||||
|
parts.Show
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub basket_pick()
|
||||||
|
|
||||||
|
build.Show
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub get_edit_basket()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim b() As Variant
|
||||||
|
Dim mix As Double
|
||||||
|
Dim touch_mix As Double
|
||||||
|
Dim touch() As Boolean
|
||||||
|
|
||||||
|
'ReDim b(basket_rows, 3)
|
||||||
|
|
||||||
|
i = 0
|
||||||
|
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
i = i - 1
|
||||||
|
|
||||||
|
ReDim b(i, 3)
|
||||||
|
ReDim touch(i)
|
||||||
|
|
||||||
|
i = 0
|
||||||
|
mix = 0
|
||||||
|
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
||||||
|
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
|
||||||
|
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
|
||||||
|
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
|
||||||
|
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
|
||||||
|
If b(i, 3) = "" Then b(i, 3) = 0
|
||||||
|
mix = mix + b(i, 3)
|
||||||
|
If Not Intersect(basket_touch, Worksheets("month").Cells(33 + i, 17)) Is Nothing Then
|
||||||
|
touch_mix = touch_mix + b(i, 3)
|
||||||
|
touch(i) = True
|
||||||
|
End If
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
|
||||||
|
'evaluate mix changes and force to 100
|
||||||
|
For i = 0 To UBound(b, 1)
|
||||||
|
If Not touch(i) Then
|
||||||
|
b(i, 3) = b(i, 3) + b(i, 3) * (1 - mix) / (mix - touch_mix)
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
dumping = True
|
||||||
|
|
||||||
|
'put the mix plug back on the the sheet
|
||||||
|
For i = 0 To UBound(b, 1)
|
||||||
|
Worksheets("month").Cells(33 + i, 17) = b(i, 3)
|
||||||
|
Next i
|
||||||
|
|
||||||
|
dumping = False
|
||||||
|
|
||||||
|
Worksheets("_month").Range("U2:X5000").ClearContents
|
||||||
|
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user