Question

有没有一种编码方法，可以将具有3个名称的单元格转换为2个单元格？例如，A1“ John Dory”变为A1“ John” B1“ Dory”。问题是当有3个字（中间名）时，它会自动为3个单元格执行此操作。如果它可以是A1或B1中的中间名，那将是很好的。不知道如何编码。下面的例子

Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True

任何帮助将不胜感激

Answer 1

基本上，您是将所有值放入一个数组中，将它们拆分为2D数组，然后一次将它们全部写回到工作表中。

经过10万行测试：

测试1 = 0.67秒
  测试2 = 0.66秒
  测试3 = 0.67秒

Option Explicit

Sub customText2Col()

    Dim startTime As Double

    startTime = Timer

    Dim startRng As Range, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)

    With ws
        Set startRng = .Range(.Cells(1, "A"), .Cells(lastRow(ws), "A"))
    End With

    ' Place startRng's values into an array
    Dim rawTxtArr, newTxtArr()
    rawTxtArr = startRng
    ReDim newTxtArr(1 To UBound(rawTxtArr), 1 To 2)

    Dim i As Long, x As Long, tmpArr
    For i = LBound(rawTxtArr) To UBound(rawTxtArr)
        tmpArr = Split(rawTxtArr(i, 1))
        newTxtArr(i, 1) = tmpArr(0)
        For x = 1 To UBound(tmpArr)
            newTxtArr(i, 2) = Trim(newTxtArr(i, 2) & " " & tmpArr(x))
        Next x
        Erase tmpArr
    Next i

    ws.Range("A1:B" & lastRow(ws)).Value = newTxtArr

    MsgBox Timer - startTime

End Sub

Function lastRow(ws As Worksheet, Optional col As Variant = 1) As Long
    With ws
        lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
    End With
End Function

Answer 2

我不确定您是否可以使用Text to Columns方法来使分隔符多次出现。

此代码将采用Column A中的值并返回Column B中的名字，并返回第二和姓在Column C

中

说明

从第2行到最后一行（Arr）加载数组（LRow）
使用Excel函数Left和Right提取所需的字符串。 InStr是Excel函数Search的VBA版本。 Chr(32)只是 space
在相应行上输出值。由于数组默认的第一个索引为0，因此在将索引与行号相关联时，您将需要使用i + 1，否则所有值都将偏移1。

根据需要调整列，并在第三行上调整工作表名称。这也假设存在一个单行标题

Sub Custom_Delim()

Dim i As Long, LRow As Long, Arr
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")

LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Arr = ws.Range("A2:A" & LRow).Value

Application.ScreenUpdating = False
    For i = LBound(Arr) To UBound(Arr)
        ws.Range("B" & i + 1) = Left(Arr(i, 1), InStr(Arr(i, 1), Chr(32)) - 1)
        ws.Range("C" & i + 1) = Right(Arr(i, 1), Len(Arr(i, 1)) - InStr(Arr(i, 1), Chr(32)))
    Next i
Application.ScreenUpdating = True

End Sub

使用文本到列将三单词字符串转换为仅两列

2 个答案:

经过10万行测试：

说明