add user-defined Excel function and add function to parse strings into arrays

This commit is contained in:
Paul Trowbridge 2022-06-01 15:24:29 -04:00
parent e277b326c7
commit edcd42947f
2 changed files with 56 additions and 2 deletions

View File

@ -1,6 +1,9 @@
Attribute VB_Name = "PriceLists" Attribute VB_Name = "PriceLists"
Option Explicit Option Explicit
Public tbo As New TheBigOne
Sub test_full20() Sub test_full20()
'------------------------------------setup------------------------------------------------- '------------------------------------setup-------------------------------------------------
@ -1021,3 +1024,15 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
End Sub End Sub
Public Function plevel_segment(plevel, segment_num) As String
Dim i As Long
Dim j As Long
Dim loc As String
loc = "U.BOC.DI"
Dim ret() As String
plevel_segment = tbo.TXTp_ParseCSV(loc, ".")(segment_num + 1)
End Function

View File

@ -2101,6 +2101,45 @@ Function TXTp_ParseCSVrow(ByRef csv() As String, row As Long, col As Integer) As
End Function End Function
Function TXTp_ParseCSV(ByRef text As String, seperator As String) As String()
Dim i As Long
Dim ci As Long
Dim cc() As Long
Dim qflag As Boolean
Dim rtn() As String
ReDim cc(1000)
ci = 1
cc(0) = 0
For i = 1 To Len(text)
If Mid(text, i, 1) = """" Then
If qflag = True Then
qflag = False
ElseIf qflag = False Then
qflag = True
End If
End If
If Mid(text, i, 1) = seperator Then
If Not qflag Then
cc(ci) = i
ci = ci + 1
End If
End If
Next i
cc(ci) = i
ReDim rtn(ci - 1)
For i = 0 To UBound(rtn)
rtn(i) = Mid(text, cc(i) + 1, cc(i + 1) - (cc(i) + 1))
If Mid(rtn(i), 1, 1) = Chr(34) Then rtn(i) = Mid(rtn(i), 2, Len(rtn(i)) - 2)
Next i
TXTp_ParseCSV = rtn
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
@ -2154,7 +2193,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
@ -2163,7 +2202,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