VBA UDF to split string array

问题:

I've written this function which works, now I want to be able to call it as a worksheet function as in the pics, any guidance would be welcome:

There are two parts to the array separated by a semi-colon.

Function CellToRange(strDelimiter As String, Optional strColDelimiter As String) As String

    On Error GoTo CellToRange_Error

    Dim rnSource, rnDest As Range
    Dim i As Integer
    Dim Orig As Variant
    Dim txt As String
    Dim intPos As Integer

    Set rnSource = Range("F16")
    Set rnDest = Range("D21")

    txt = rnSource
    Orig = Split(txt, strDelimiter)
    intPos = InStr(1, txt, strColDelimiter) / 2

    For i = 0 To intPos - 1
        If i = intPos - 1 Then
            rnDest.Offset(i).Value = Mid(Orig(i), 1, InStr(1, Orig(i), strColDelimiter) - 1)
        Else
            rnDest.Offset(i).Value = Orig(i)
        End If
    Next i

    For i = intPos - 1 To UBound(Orig)
        If i = intPos - 1 Then
            rnDest.Offset(i - (intPos - 1), 1).Value = Mid(Orig(i), InStr(1, Orig(i), strColDelimiter) + 1, Len(Orig(i)))
        Else
            rnDest.Offset(i - (intPos - 1), 1).Value = Orig(i)
        End If
    Next i

    On Error GoTo 0

    Exit Function

CellToRange_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CellToRange of Function Functions"

End Function

回答1:

Here be dragons. Haven't tryed this before and I hope I understood you right.
At this moment it takes source cell, where numbers are located, and destination cell, which is top left cell of output table. Currently delimiters are "," and ";" for lines and columns respectively.
You can modify sub to suit your needs from this point.

Public Function mytest(src, dest)
    dest.Parent.Evaluate "test(" & src.Address(False, False) & ", " & dest.Address(False, False) & ")"
    mytest = "wut"
End Function

Sub test(src As Range, dest As Range)
    Dim chr, rows, cols
    rows = 0
    cols = 0
    For chr = 1 To Len(src.Value)
        Select Case Mid(src.Value, chr, 1)
            Case ","
                rows = rows + 1
            Case ";"
                cols = cols + 1
                rows = 0
            Case Else
                Cells(dest.Row + rows, dest.Column + cols).Value = Cells(dest.Row + rows, dest.Column + cols).Value & Mid(src.Value, chr, 1)
        End Select
    Next chr
End Sub

P.S. I might be wrong but this will be the closest as you can get with modifying cells with UDF.
P.P.S. Welp, my Function actualy returns surprising results, I'll try to fix it asap, but mb you have other suggestions.