updates
This commit is contained in:
parent
4e5cf05396
commit
414c044fc0
251
FL.bas
251
FL.bas
@ -241,9 +241,9 @@ Sub GrabBorrowHist()
|
||||
|
||||
End Sub
|
||||
|
||||
Function fn_coln_colchar(colnum As Long) As String
|
||||
Function fn_coln_colchar(colNum As Long) As String
|
||||
|
||||
fn_coln_colchar = colnum / 26
|
||||
fn_coln_colchar = colNum / 26
|
||||
|
||||
End Function
|
||||
|
||||
@ -561,7 +561,7 @@ Sub sql_from_range_pg_noqh()
|
||||
Dim wapi As New Windows_API
|
||||
Dim r() As String
|
||||
Selection.CurrentRegion.Select
|
||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, False, "S", "S", "S", "S", "A"))
|
||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, False))
|
||||
|
||||
End Sub
|
||||
|
||||
@ -1323,7 +1323,7 @@ Sub price_load_pcore()
|
||||
'-------identify the active sheet and load the contents to an array-----------
|
||||
|
||||
Set sh = ActiveSheet
|
||||
big = x.SHTp_Get(sh.Name, 3, 1, True)
|
||||
big = x.SHTp_Get(sh.Name, 1, 1, True)
|
||||
|
||||
'------iterate through the column headers to identify the price lists---------
|
||||
|
||||
@ -1341,7 +1341,7 @@ Sub price_load_pcore()
|
||||
ReDim Preserve pcol(pcount)
|
||||
ReDim typeflag(9)
|
||||
|
||||
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
|
||||
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then
|
||||
MsgBox (Err.Description)
|
||||
Exit Sub
|
||||
End If
|
||||
@ -1380,16 +1380,16 @@ Sub price_load_pcore()
|
||||
load(3, i) = big(3, i)
|
||||
load(4, i) = big(4, i)
|
||||
load(5, i) = big(5, i)
|
||||
load(6, i) = Format(big(pcol(pcount) - 3, i), "####0.00")
|
||||
load(6, i) = big(6, i)
|
||||
load(7, i) = Format(big(pcol(pcount) - 2, i), "####0.00")
|
||||
load(8, i) = Format(big(pcol(pcount) - 1, i), "####0.00")
|
||||
load(9, i) = big(pcol(pcount) - 0, i)
|
||||
Next i
|
||||
'------build insert statement for target price list-----
|
||||
sql = "BEGIN;"
|
||||
sql = sql & vbCrLf & "DELETE FROM rlarp.pcore WHERE plist = '" & load(9, 1) & "';"
|
||||
sql = sql & vbCrLf & "INSERT INTO rlarp.pcore"
|
||||
sql = sql & vbCrLf & x.SQLp_build_sql_values(load, True, True, PostgreSQL, False, "S", "S", "S", "S", "S", "S", "N", "N", "N", "S") & ";"
|
||||
sql = sql & vbCrLf & "DELETE FROM rlarp.plcore WHERE plist = '" & load(9, 1) & "';"
|
||||
sql = sql & vbCrLf & "INSERT INTO rlarp.plcore"
|
||||
sql = sql & vbCrLf & x.SQLp_build_sql_values(big, True, True, PostgreSQL, False, "S", "S", "S", "S", "S", "S", "S", "N", "N", "S") & ";"
|
||||
sql = sql & vbCrLf & "COMMIT;"
|
||||
'------do the insert------------------------------------
|
||||
If Not x.ADOp_Exec(0, sql) Then
|
||||
@ -1403,6 +1403,105 @@ Sub price_load_pcore()
|
||||
|
||||
End Sub
|
||||
|
||||
Sub price_load_pcore_one()
|
||||
|
||||
Dim x As New TheBigOne 'function library
|
||||
Dim sh As Worksheet 'target worksheet
|
||||
Dim big() As String 'all price lists in one array
|
||||
Dim load() As String 'individual price list to be loaded
|
||||
Dim pcount As Long 'count of price list
|
||||
Dim pcol() As Long 'hold the positions of each price list
|
||||
ReDim pcol(30) 'size the array starting with 30 and trim later
|
||||
Dim dcol() As Integer 'columns to be deleted
|
||||
Dim typeflag() As String 'array of column types
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim sql As String
|
||||
|
||||
'-------identify the active sheet and load the contents to an array-----------
|
||||
|
||||
Set sh = ActiveSheet
|
||||
big = x.SHTp_Get(sh.Name, 1, 1, True)
|
||||
|
||||
'------iterate through the column headers to identify the price lists---------
|
||||
|
||||
pcount = 0
|
||||
For i = 0 To UBound(big, 1)
|
||||
If big(i, 0) = "listcode" Then
|
||||
pcount = pcount + 1
|
||||
pcol(pcount) = i
|
||||
End If
|
||||
Next i
|
||||
|
||||
'------if no columns are labeled plist then exit------------------------------
|
||||
|
||||
If pcount = 0 Then Exit Sub
|
||||
ReDim Preserve pcol(pcount)
|
||||
ReDim typeflag(9)
|
||||
|
||||
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.56.60.254", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then
|
||||
MsgBox (Err.Description)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'------prepare upload for each price list-------------------------------------
|
||||
|
||||
typeflag(0) = "S"
|
||||
typeflag(1) = "S"
|
||||
typeflag(2) = "S"
|
||||
typeflag(3) = "S"
|
||||
typeflag(4) = "S"
|
||||
typeflag(5) = "S"
|
||||
typeflag(6) = "N"
|
||||
typeflag(7) = "N"
|
||||
typeflag(8) = "N"
|
||||
typeflag(9) = "S"
|
||||
|
||||
For pcount = 1 To UBound(pcol)
|
||||
ReDim load(9, UBound(big, 2))
|
||||
'----set headers-----
|
||||
' load(0, 0) = "stlc"
|
||||
' load(1, 0) = "coltier"
|
||||
' load(2, 0) = "branding"
|
||||
' load(3, 0) = "accs"
|
||||
' load(4, 0) = "suff"
|
||||
' load(5, 0) = "pckg"
|
||||
' load(6, 0) = "pack"
|
||||
' load(7, 0) = "mp"
|
||||
' load(8, 0) = "bulk"
|
||||
' load(9, 0) = "plist"
|
||||
'-----populate------------
|
||||
' For i = 1 To UBound(big, 2)
|
||||
' load(0, i) = big(0, i)
|
||||
' load(1, i) = big(1, i)
|
||||
' load(2, i) = big(2, i)
|
||||
' load(3, i) = big(3, i)
|
||||
' load(4, i) = big(4, i)
|
||||
' load(5, i) = big(5, i)
|
||||
' load(6, i) = big(6, i)
|
||||
' load(7, i) = Format(big(pcol(pcount) - 2, i), "####0.00")
|
||||
' load(8, i) = Format(big(pcol(pcount) - 1, i), "####0.00")
|
||||
' load(9, i) = big(pcol(pcount) - 0, i)
|
||||
' Next i
|
||||
'------build insert statement for target price list-----
|
||||
sql = "BEGIN;"
|
||||
sql = sql & vbCrLf & "DELETE FROM rlarp.plcore WHERE listcode= '" & big(9, 1) & "';"
|
||||
sql = sql & vbCrLf & "INSERT INTO rlarp.plcore"
|
||||
sql = sql & vbCrLf & x.SQLp_build_sql_values(big, True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "N", "N", "S") & ";"
|
||||
sql = sql & vbCrLf & "COMMIT;"
|
||||
'------do the insert------------------------------------
|
||||
If Not x.ADOp_Exec(0, sql) Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
Next pcount
|
||||
|
||||
Call x.ADOp_CloseCon(0)
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub price_issues()
|
||||
|
||||
Dim x As New TheBigOne
|
||||
@ -1660,6 +1759,138 @@ Sub clear_page_breaks()
|
||||
|
||||
End Sub
|
||||
|
||||
Sub MergeSameCellsInColumn()
|
||||
|
||||
Dim ws As Worksheet
|
||||
Dim rng As Range
|
||||
Dim cell As Range
|
||||
Dim firstRow As Long
|
||||
Dim lastRow As Long
|
||||
Dim colNum As Long
|
||||
Dim startMerge As Range
|
||||
Dim endMerge As Range
|
||||
|
||||
' Set the worksheet where you want to perform the operation
|
||||
Set ws = ActiveSheet
|
||||
|
||||
' Define the column number to check for duplicates (A = 1, B = 2, etc.)
|
||||
colNum = Selection.column
|
||||
|
||||
' Define the range of rows to work on (you can customize this as needed)
|
||||
firstRow = Selection.row
|
||||
lastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).row
|
||||
|
||||
' Set the range of cells in the specified column to process
|
||||
Set rng = ws.Range(ws.Cells(firstRow, colNum), ws.Cells(lastRow, colNum))
|
||||
|
||||
Application.DisplayAlerts = False
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
Set startMerge = Nothing
|
||||
|
||||
For Each cell In rng
|
||||
If startMerge Is Nothing Then
|
||||
Set startMerge = cell
|
||||
ElseIf cell.value <> startMerge.value Then
|
||||
Set endMerge = cell.Offset(-1, 0)
|
||||
If startMerge.row <> endMerge.row Then
|
||||
ws.Range(startMerge, endMerge).merge
|
||||
End If
|
||||
Set startMerge = cell
|
||||
End If
|
||||
Next cell
|
||||
|
||||
If cell Is Nothing Then Set cell = ws.Cells(ws.Rows.Count, colNum).End(xlUp)
|
||||
|
||||
' Check for the last group of same values
|
||||
If startMerge.row <> cell.row Then
|
||||
ws.Range(startMerge, cell).merge
|
||||
End If
|
||||
|
||||
Application.DisplayAlerts = True
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
End Sub
|
||||
|
||||
Sub merge_block(column_num As Long, row_num As Long)
|
||||
|
||||
Dim ws As Worksheet
|
||||
Dim rng As Range
|
||||
Dim cell As Range
|
||||
Dim firstRow As Long
|
||||
Dim lastRow As Long
|
||||
Dim colNum As Long
|
||||
Dim startMerge As Range
|
||||
Dim endMerge As Range
|
||||
|
||||
' Set the worksheet where you want to perform the operation
|
||||
Set ws = ActiveSheet
|
||||
|
||||
' Define the column number to check for duplicates (A = 1, B = 2, etc.)
|
||||
colNum = column_num
|
||||
' Define the range of rows to work on (you can customize this as needed)
|
||||
firstRow = row_num
|
||||
lastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).row
|
||||
|
||||
' Set the range of cells in the specified column to process
|
||||
Set rng = ws.Range(ws.Cells(firstRow, colNum), ws.Cells(lastRow, colNum))
|
||||
|
||||
Application.DisplayAlerts = False
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
Set startMerge = Nothing
|
||||
|
||||
For Each cell In rng
|
||||
If startMerge Is Nothing Then
|
||||
Set startMerge = cell
|
||||
ElseIf cell.value <> startMerge.value Then
|
||||
Set endMerge = cell.Offset(-1, 0)
|
||||
If startMerge.row <> endMerge.row Then
|
||||
ws.Range(startMerge, endMerge).merge
|
||||
End If
|
||||
Set startMerge = cell
|
||||
End If
|
||||
Next cell
|
||||
|
||||
If cell Is Nothing Then Set cell = ws.Cells(ws.Rows.Count, colNum).End(xlUp)
|
||||
|
||||
' Check for the last group of same values
|
||||
If startMerge.row <> cell.row Then
|
||||
ws.Range(startMerge, cell).merge
|
||||
End If
|
||||
|
||||
Application.DisplayAlerts = True
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
End Sub
|
||||
|
||||
Sub merge_first_2_col_row3()
|
||||
|
||||
Call FL.merge_block(1, 3)
|
||||
Call FL.merge_block(2, 3)
|
||||
With ActiveSheet.Range("A3:B10000").Borders
|
||||
.LineStyle = xlContinuous
|
||||
.Weight = xlThin
|
||||
.ColorIndex = xlAutomatic
|
||||
End With
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub unmerge_first2()
|
||||
|
||||
ActiveSheet.Range("A:B").MergeCells = False
|
||||
ActiveSheet.Range("A:B").Borders(xlDiagonalDown).LineStyle = xlNone
|
||||
ActiveSheet.Range("A:B").Borders(xlDiagonalUp).LineStyle = xlNone
|
||||
ActiveSheet.Range("A:B").Borders(xlEdgeLeft).LineStyle = xlNone
|
||||
ActiveSheet.Range("A:B").Borders(xlEdgeTop).LineStyle = xlNone
|
||||
ActiveSheet.Range("A:B").Borders(xlEdgeBottom).LineStyle = xlNone
|
||||
ActiveSheet.Range("A:B").Borders(xlEdgeRight).LineStyle = xlNone
|
||||
ActiveSheet.Range("A:B").Borders(xlInsideVertical).LineStyle = xlNone
|
||||
ActiveSheet.Range("A:B").Borders(xlInsideHorizontal).LineStyle = xlNone
|
||||
|
||||
End Sub
|
||||
|
||||
Sub load_ffterr()
|
||||
|
||||
Dim x As New TheBigOne
|
||||
@ -1837,5 +2068,3 @@ Sub load_index()
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user