Has anyone written an optimal VBA function that can do the inverse of =ARRAYTOTEXT(,1). Praying for-CodePudding

At first glance a mixture of mid and len (to remove the curly brackets) and textsplit would achieve this. However this does not deal with edge cases where a semicolon or comma is present in an individual element. See example below.

Let A1=1
Let B1="Semicolon ; in me"
Let A2="Comma , in me"
let B2=4

ARRAYTOTEXT(A1:B2,1)={1,"Semicolon ; in me";"Comma , in me",4} = (C)
ARAYTOTEXT_INV(C) = Spilled range identical to A1:B2

Now using a textsplit of (C) would find the semicolons and commas within the speech marks and split the text too much. I think I need some use of regex to get the desired result.

The inverse function will be applied to many such ranges so needs to be optimal. The answer needs to also be able to deal with numbers and blank values adequately.

Edit: needs to be able to solve for the below cases as well as normal text:

Numbers which don't have speech marks.
Blanks which are not surrounded by quote marks.
Sets of sets (which is less likely to happen granted) such as {"{""a,"",""b,"";""a,"",""b,""}","{""c,"",""d,"";""c,"",""d,""}"}
Edge cases {",",";"), you can imagine an element being the formula "=FIND(",",a1)" for example.

In the image below you can use ARRAYTOTEXT(B3:C4,1) to get to the value in B7. I want a function that can be placed in B10 (to spill into B10:C11) to give me the original values back i.e. the inverse of ARRAYTOTEXT.

Formula in A3:

=DROP(DROP(REDUCE(0,MID(A1,SEQUENCE(LEN(A1)),1),LAMBDA(a,b,TOCOL(LET(x,TAKE(a,1),IF(b="""",VSTACK(NOT(x),DROP(a,1)),IF(x ISNUMBER(--b),VSTACK(DROP(a,-1),TAKE(a,-1)&b),VSTACK(a,"")))),3))),1),-1)

I don't think this will tick your edge-cases.

CodePudding user response：

I had a crack at my own problem. This seems to work for all cases. Can anyone make this more efficient?

Function TEXTTOARRAY(inarr As String)

Dim nDbleQuote As Long
Dim charLng As String
Dim BrkElum() As Long
Dim lenArr As Long
Dim nCol As Long, nRow As Long, nElum As Long
Dim iLng As Long, iRows As Long, iCols As Long, iElum As Long

'Remove curly brackets
Dim Arr As String: Arr = Mid$(inarr, 2, Len(inarr) - 2)

ReDim BrkElum(1 To 1): BrkElum(1) = 0

nElum = 1
nRow = 1
nCol = 1

lenArr = Len(Arr)

'Iterate through string and find break points
For iLng = 1 To lenArr
     charLng = Mid$(Arr, iLng, 1)
If charLng = Chr(34) Then nDbleQuote = nDbleQuote   1

If WorksheetFunction.IsEven(nDbleQuote) Then
    If charLng = "," Then
    If nRow = 1 Then nCol = nCol   1
    nElum = nElum   1
    ReDim Preserve BrkElum(1 To nElum)
    BrkElum(nElum) = iLng
    ElseIf charLng = ";" Then
    nRow = nRow   1
    nElum = nElum   1
    ReDim Preserve BrkElum(1 To nElum)
    BrkElum(nElum) = iLng
    End If
End If

Next iLng

ReDim Preserve BrkElum(1 To nElum   1)
BrkElum(nElum   1) = lenArr   1

'Create array
Dim ArrOut() As Variant
ReDim ArrOut(1 To nRow, 1 To nCol)
For iRows = 1 To nRow
    For iCols = 1 To nCol
    iElum = (iRows - 1) * nCol   iCols
    ArrOut(iRows, iCols) = Mid$(Arr, BrkElum(iElum)   1, BrkElum(iElum  1) - BrkElum(iElum) - 1)
        If Left$(ArrOut(iRows, iCols), 1) = Chr(34) Then 'Remove outside quotes and replace internal double double quotes with single double quotes
        ArrOut(iRows, iCols) = Replace(Mid$(ArrOut(iRows, iCols), 2,Len(ArrOut(iRows, iCols)) - 2), Chr(34) & Chr(34), Chr(34))
        ElseIf IsNumeric(ArrOut(iRows, iCols)) Then 'Check if numeric and if so change from text to number
        ArrOut(iRows, iCols) = CDbl(ArrOut(iRows, iCols))
        End If
    Next iCols
Next iRows

TEXTTOARRAY = ArrOut

End Function