有没有人写过一个最佳的VBA函数，可以做=ARRAYTOTEXT(，1)的逆运算,祈祷excel能在一天内完成这个函数

ia2d9nvy 于 2023-01-06 发布在其他

关注(0)|答案(2)|浏览(148)

乍看之下，mid和len（去掉大括号）以及textsplit的组合可以实现这一点。然而，这并不能处理单个元素中出现分号或逗号的边缘情况。参见下面的示例。

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

现在使用（C）的textsplit会发现语音标记中的分号和逗号，并且会过多地拆分文本。我想我需要使用一些regex来获得想要的结果。
反函数将应用于许多这样的范围，所以需要是最优的。答案也需要能够充分处理数字和空白值。
编辑：需要能够解决以下情况以及正常的文本：
1.没有语音标记的数字。
1.未用引号括起的空白。
1.集合的集合（这是不太可能发生的授予），如{"{"“a，""，"“B，"";“a”、“B "、"}"、"{c”、“d”、"}";“c "、“d"、"}"}
1.边缘情况{"，"，";“），您可以想象一个元素是公式“=FIND（“，"，a1）”。
在下图中，您可以使用ARRAYTOTEXT（B3：C4，1）来获取B7中的值。我需要一个可以放置在B10中（溢出到B10：C11中）的函数，以给予原始值，即ARRAYTOTEXT的反函数。See Excel Example

excel

来源：https://stackoverflow.com/questions/75006373/has-anyone-written-an-optimal-vba-function-that-can-do-the-inverse-of-arraytote

2条答案

按热度按时间

gc0ot86w1#

这实际上一点也不简单。但不妨试试：

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)

我不认为这会勾住你的边缘案件。

赞(0）回复(0）举报 2023-01-06

kuuvgm7e2#

我对自己的问题有了一个突破口。这似乎对所有情况都有效。有没有人能让这个更有效率？

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

您可以在B4:D6中的原始范围下方链接的图像中看到。
你可以在B8ARRAYTOTEXT(B4:D6,1)中看到。
您可以在B10:B12TEXTTOARRAY(B8)中看到（所需的功能）。
在B14:D16中可以看到B4:D6=B10:D12中的所有细胞。
How it has worked out

赞(0）回复(0）举报 2023-01-06

我来回答

有没有人写过一个最佳的VBA函数，可以做=ARRAYTOTEXT(，1)的逆运算,祈祷excel能在一天内完成这个函数

2条答案

相关问题

热门标签

最新问答