changes made during target price rebuild
This commit is contained in:
parent
d4b4236f3e
commit
5928c83a24
186
TheBigOne.cls
186
TheBigOne.cls
@ -2304,7 +2304,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
|
||||
|
||||
End Function
|
||||
|
||||
Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
|
||||
Public Function json_from_table(ByRef tbl As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
|
||||
|
||||
|
||||
Dim ajson As String
|
||||
@ -2324,14 +2324,13 @@ Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As Str
|
||||
needs_braces = needs_braces + 1
|
||||
If needs_comma Then json = json & ","
|
||||
needs_comma = True
|
||||
If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
|
||||
If IsNumeric(tbl(r, c)) Then
|
||||
json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & tbl(r, c)
|
||||
Else
|
||||
'test if item is a json object
|
||||
If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
|
||||
json = json & """" & tbl(LBound(tbl, 2), c) & """" & ":" & tbl(r, c)
|
||||
If Left(tbl(r, c), 1) = "{" Or Left(tbl(r, c), 1) = "[" Then
|
||||
json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & tbl(r, c)
|
||||
Else
|
||||
json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
|
||||
json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & Chr(34) & Replace(tbl(r, c), Chr(34), Chr(34) & Chr(34)) & Chr(34)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
@ -3153,3 +3152,178 @@ Sub frmListBoxHeader(ByRef hdr As MSForms.ListBox, ByRef det As MSForms.ListBox,
|
||||
End Sub
|
||||
|
||||
|
||||
Function TBLp_StackAndUnique(ByRef tbl1() As String, ByRef tbl2() As String, Optional keyColumns As Variant) As String()
|
||||
Dim dict As Object
|
||||
Set dict = CreateObject("Scripting.Dictionary")
|
||||
|
||||
Dim i As Long, j As Long
|
||||
Dim key As String
|
||||
Dim colCount As Long
|
||||
Dim combined() As String
|
||||
Dim rowIndex As Long
|
||||
Dim out() As String
|
||||
Dim kCols As Variant
|
||||
|
||||
' === Determine number of columns ===
|
||||
colCount = UBound(tbl1, 1) + 1
|
||||
|
||||
' === Decide which columns define uniqueness ===
|
||||
If IsMissing(keyColumns) Then
|
||||
ReDim kCols(colCount - 1)
|
||||
For j = 0 To colCount - 1
|
||||
kCols(j) = j
|
||||
Next j
|
||||
Else
|
||||
kCols = keyColumns
|
||||
End If
|
||||
|
||||
' === Prepare output array with enough space ===
|
||||
Dim totalRows As Long
|
||||
totalRows = (UBound(tbl1, 2) + UBound(tbl2, 2)) + 2 ' +2 for header + safety
|
||||
ReDim combined(colCount - 1, totalRows - 1)
|
||||
|
||||
rowIndex = 0
|
||||
|
||||
' === 1. Copy header from tbl1 ===
|
||||
For j = 0 To colCount - 1
|
||||
combined(j, rowIndex) = tbl1(j, 0)
|
||||
Next j
|
||||
rowIndex = rowIndex + 1
|
||||
|
||||
' === 2. Add data rows from tbl1 ===
|
||||
For i = 1 To UBound(tbl1, 2)
|
||||
key = ""
|
||||
For j = LBound(kCols) To UBound(kCols)
|
||||
key = key & "|" & tbl1(kCols(j), i)
|
||||
Next j
|
||||
If Not dict.exists(key) Then
|
||||
dict.Add key, rowIndex
|
||||
For j = 0 To colCount - 1
|
||||
combined(j, rowIndex) = tbl1(j, i)
|
||||
Next j
|
||||
rowIndex = rowIndex + 1
|
||||
End If
|
||||
Next i
|
||||
|
||||
' === 3. Add data rows from tbl2 ===
|
||||
For i = 1 To UBound(tbl2, 2)
|
||||
key = ""
|
||||
For j = LBound(kCols) To UBound(kCols)
|
||||
key = key & "|" & tbl2(kCols(j), i)
|
||||
Next j
|
||||
If Not dict.exists(key) Then
|
||||
dict.Add key, rowIndex
|
||||
For j = 0 To colCount - 1
|
||||
combined(j, rowIndex) = tbl2(j, i)
|
||||
Next j
|
||||
rowIndex = rowIndex + 1
|
||||
End If
|
||||
Next i
|
||||
|
||||
' === 4. Trim final output ===
|
||||
ReDim out(colCount - 1, rowIndex - 1)
|
||||
For i = 0 To rowIndex - 1
|
||||
For j = 0 To colCount - 1
|
||||
out(j, i) = combined(j, i)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
TBLp_StackAndUnique = out
|
||||
End Function
|
||||
|
||||
|
||||
Function TBLp_MergePreferValueWithHeader(tbl1() As String, tbl2() As String, _
|
||||
keyColumns As Variant, valColumn As Long) As String()
|
||||
Dim dict As Object
|
||||
Set dict = CreateObject("Scripting.Dictionary")
|
||||
|
||||
Dim i As Long, j As Long
|
||||
Dim key As String
|
||||
Dim colCount As Long
|
||||
Dim result() As String
|
||||
Dim rowIndex As Long
|
||||
Dim combined() As String
|
||||
Dim candidate() As String
|
||||
|
||||
' === Determine number of columns ===
|
||||
colCount = UBound(tbl1, 1) + 1
|
||||
|
||||
' === Prepare combined big-enough array ===
|
||||
Dim totalRows As Long
|
||||
totalRows = (UBound(tbl1, 2) + UBound(tbl2, 2)) + 2
|
||||
ReDim combined(colCount - 1, totalRows - 1)
|
||||
|
||||
rowIndex = 0
|
||||
|
||||
' === 1. Copy header ===
|
||||
For j = 0 To colCount - 1
|
||||
combined(j, rowIndex) = tbl1(j, 0)
|
||||
Next j
|
||||
rowIndex = rowIndex + 1
|
||||
|
||||
' === 2. Process both tables ===
|
||||
For i = 1 To UBound(tbl1, 2)
|
||||
Call AddOrPrefer(dict, combined, rowIndex, tbl1, i, keyColumns, valColumn)
|
||||
Next i
|
||||
|
||||
For i = 1 To UBound(tbl2, 2)
|
||||
Call AddOrPrefer(dict, combined, rowIndex, tbl2, i, keyColumns, valColumn)
|
||||
Next i
|
||||
|
||||
' === 3. Trim output ===
|
||||
ReDim result(colCount - 1, rowIndex - 1)
|
||||
For i = 0 To rowIndex - 1
|
||||
For j = 0 To colCount - 1
|
||||
result(j, i) = combined(j, i)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
TBLp_MergePreferValueWithHeader = result
|
||||
End Function
|
||||
|
||||
Private Sub AddOrPrefer(ByRef dict As Object, ByRef combined() As String, ByRef rowIndex As Long, _
|
||||
ByRef table() As String, ByVal sourceRow As Long, _
|
||||
ByVal keyColumns As Variant, ByVal valColumn As Long)
|
||||
Dim j As Long
|
||||
Dim key As String
|
||||
Dim candidateVal As String
|
||||
Dim existingRow As Long
|
||||
|
||||
' Build key
|
||||
key = ""
|
||||
For j = LBound(keyColumns) To UBound(keyColumns)
|
||||
key = key & "|" & table(keyColumns(j), sourceRow)
|
||||
Next j
|
||||
|
||||
candidateVal = trim(table(valColumn, sourceRow))
|
||||
|
||||
If dict.exists(key) Then
|
||||
existingRow = dict(key)
|
||||
' Decide if new row is "better"
|
||||
If IsBetterValue(candidateVal, combined(valColumn, existingRow)) Then
|
||||
' Replace existing row
|
||||
For j = 0 To UBound(table, 1)
|
||||
combined(j, existingRow) = table(j, sourceRow)
|
||||
Next j
|
||||
End If
|
||||
Else
|
||||
' Add new unique row
|
||||
dict.Add key, rowIndex
|
||||
For j = 0 To UBound(table, 1)
|
||||
combined(j, rowIndex) = table(j, sourceRow)
|
||||
Next j
|
||||
rowIndex = rowIndex + 1
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Function IsBetterValue(newVal As String, existingVal As String) As Boolean
|
||||
If existingVal = "" Or existingVal = "-" Then
|
||||
If newVal <> "" And newVal <> "-" Then
|
||||
IsBetterValue = True
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
IsBetterValue = False
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user