Question

Apples, Oranges, Strawberries, Pears, Almonds, Peanuts, Peaches

我想找到＆＃34;，＆＃34;从后向（instrrev）执行类似于Excel中的文本到列的功能，这将

#1 > Apples, Oranges
#2 > Apples | Oranges

执行＃1到＃2的操作。

但是，我希望最多列数为5（拆分为5个，从后向搜索基于拆分的字符）

这样最上面的例子会导致：

Apples, Oranges, Strawberries | Pears | Almonds | Peanuts | Peaches

请记住，文本可能没有逗号，所以我需要先检查它们是否存在

感谢您的帮助！

Answer 1

尝试此操作，将示例文本放在单元格中，选择该单元格，然后运行下面的单元格。您将需要对此进行测试，并可能自己处理某些情况 - 但是这段代码应该让您继续并按照您的示例进行操作。

Sub SplitIntoColumns()
Dim intMaxCols          As Integer
Dim intCommaFoundPos    As Integer
Dim intNumCommasFound   As Integer
Dim strTextToCheck      As String
Dim strFoundText        As String
Dim intRowToWriteTo     As Integer
Dim intColToWriteTo     As Integer

    'this should be max num of columns you want -1
    intMaxCols = 4

    'just putting the text into the activecell and running on that
strTextToCheck = ActiveCell

'row to write output to
intRowToWriteTo = 10

'column to write output to - it will go backwards from here
intColToWriteTo = 10

'find the comma
intCommaFoundPos = InStrRev(strTextToCheck, ",")

'if there is a comma
If intCommaFoundPos > 0 Then

    'loop until you have looped the max columns number of times, or until there are no commas left in the string
    Do Until (intNumCommasFound = intMaxCols) Or intCommaFoundPos = 0

        'get comma position
        intCommaFoundPos = InStrRev(strTextToCheck, ",")

        'if there is still a comma
        If intCommaFoundPos > 0 Then

            'keep track of the number found
            intNumCommasFound = intNumCommasFound + 1

            'take everything to right of comma
            strFoundText = Trim(Mid(strTextToCheck, intCommaFoundPos + 1, Len(strTextToCheck)))

            'write to sheet, adjust next column number
             ActiveSheet.Cells(intRowToWriteTo, intColToWriteTo) = strFoundText
            intColToWriteTo = intColToWriteTo - 1

            'change the text to check to not include the word just found
            strTextToCheck = Left(strTextToCheck, intCommaFoundPos - 1)

        End If

    Loop

    'if there is any text left, write to sheet
    If Len(strTextToCheck) > 0 Then ActiveSheet.Cells(intRowToWriteTo, intColToWriteTo) = strTextToCheck

End If

End Sub

Answer 2

您也可以在公式中实现它：

=IF(LEN(A3)-LEN(SUBSTITUTE(A3,",",""))<5,SUBSTITUTE(A3,",","|"),REPLACE(A3,FIND("@",SUBSTITUTE(A3,",","@",LEN(A3)-LEN(SUBSTITUTE(A3,",",""))-4))+1,LEN(A3),SUBSTITUTE(MID(A3,FIND("@",SUBSTITUTE(A3,",","@",LEN(A3)-LEN(SUBSTITUTE(A3,",",""))-4))+1,LEN(A3)),",","|")))

字符串在A3

中

工作原理：

找出＆＃34;，＆＃34;的数量在字符串中通过从完整字符串中减去逗号字符串的长度。
如果少于5个逗号，则替换所有＆＃34;，＆＃34;与＆＃34; |＆＃34;
如果等于或大于5个逗号，则从右边找到第5个逗号的字符位置，并用替换字符串替换该字符位置后面的字符串。

Excel VBA文本到列向后使用最多列数

2 个答案: