Question

我试图将文本自动化为列函数，通过VBA在excel中用空格分隔。

strArray = split (currentSheet.Cells(i,1).Value), " ")

For j = 0 To (UBound(strArray) - LBound(strArray))
       currentSheet.Cells(i, 1 + j).NumberFormat = "@"
       currentSheet.Cells(i, 1 + j).Value = strArray(j)
Next j

当我得到一些文字时遇到的问题： KIDS'R'KIDS

第二个单词'R'在单元格中变为 R'，但是如果我在excel中构建文本到列函数时将空格作为分隔符这个单词来了仅作为单元格中的'R'。

如果我在开头添加一个单引号''R'，则问题会解决，但我认为这可能会影响我对数据的进一步处理。

那有什么办法吗？

Answer 1

我认为你会喜欢＆＃34; KIDS＆＃39; R＆＃39; KIDS＆＃34;喜欢＆＃34; KIDS＆＃34;，＆＃34;＆＃39; R＆＃39;＆＃34;，＆＃34; KIDS＆＃34;

替换下面的

currentSheet.Cells(i, 1 + j).Value = strArray(j)

带

If Left(strArray(j), 1) = "'" Then
    currentSheet.Cells(i, 1 + j).Value = "'" & strArray(j)
else
    currentSheet.Cells(i, 1 + j).Value = strArray(j)
End If

基本上，您在输出之前分析文本。因为Excel会假设第一个＆＃34;＆＃39;＆＃34;是一个特殊的角色并删除它。

Answer 2

使用TextToColumns VBA功能 - 它保留'。此代码仅适用于单个单元格而不是范围。

Sub Test()
    With ThisWorkbook.Worksheets("Sheet1")
        TextToCols .Range("A1"), .Range("B1")
    End With
End Sub


'Comments indicate how to add a blank column between words.
Public Sub TextToCols(DataRange As Range, Optional DestinationRange As Range)

    Dim nElements As Long
    Dim vFieldInfo As Variant
    Dim x As Long

    If DataRange.Cells.Count = 1 Then

        'Add an extra space to each space (1 space becomes 2).
        DataRange = Replace(DataRange, " ", "  ")

        If DestinationRange Is Nothing Then
            Set DestinationRange = DataRange
        End If

        nElements = Len(DataRange.Value) - Len(Replace(DataRange.Value, " ", ""))

        ReDim vFieldInfo(1 To nElements)
        For x = 1 To nElements
            vFieldInfo(x) = Array(x, 1)
        Next x

        'Add ConsecutiveDelimiter:=False to the TextToColumns.
        DataRange.TextToColumns _
            Destination:=DestinationRange, _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Space:=True, _
            FieldInfo:=vFieldInfo

        'Remove the extra space (2 spaces becomes 1)
        DataRange = Replace(DataRange, "  ", " ")

    End If

End Sub

返回此信息：

如果单词和ConsecutiveDelimiter之间的空格设置为false，则会返回：

此代码块允许您将文本字符串传递给TextToCols过程。您可以将代码组合起来接受范围或文本字符串，但这将是相当多的额外代码我添加了评论，以显示我从原来的位置更改了代码。

Sub Test()
    With ThisWorkbook.Worksheets("Sheet1")
        TextToCols "Kids 'R' Kids", .Range("B1")
    End With
End Sub


Public Sub TextToCols(TextToSplit As String, _
                      DestinationRange As Range)

    Dim nElements As Long
    Dim vFieldInfo As Variant
    Dim x As Long
    Dim wrkSht As Worksheet
    Dim DataRange As Range

    'Add a temporary worksheet to perform the split on.
    Set wrkSht = DestinationRange.Parent.Parent.Worksheets.Add
    wrkSht.Cells(1, 1) = TextToSplit
    Set DataRange = wrkSht.Cells(1, 1)

    'Don't need this line anymore as a text string will never be counted in cells.
    'If DataRange.Cells.Count = 1 Then

        'Add an extra space to each space (1 space becomes 2).
        DataRange = Replace(DataRange, " ", "  ")

        'Can remove this code block as DestinationRange
        'can't be optional with a text string - we need somewhere to paste the data.
'        If DestinationRange Is Nothing Then
'            Set DestinationRange = DataRange
'        End If

        nElements = Len(DataRange) - Len(Replace(DataRange, " ", ""))

        ReDim vFieldInfo(1 To nElements)
        For x = 1 To nElements
            vFieldInfo(x) = Array(x, 1)
        Next x

        'Add ConsecutiveDelimiter:=False to the TextToColumns.
        'Note: DestinationRange is always the same sheet as DataRange.
        '      Even if DestinationRange is pointing to another sheet, it will split
        '      to the address but on the DataRange sheet.
        DataRange.TextToColumns _
            Destination:=DestinationRange, _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Space:=True, _
            FieldInfo:=vFieldInfo

        'This line looks at the correct DestinationRange address but on the temp sheet.
        'It then resizes that range to however many cells were split to and copies that
        'to our real destination.
        DataRange.Parent.Range(DestinationRange.Address).Resize(, x).Copy _
            Destination:=DestinationRange

        'Can remove this line as well - the whole sheet is deleted after the split.
        'Remove the extra space (2 spaces becomes 1)
        'DataRange = Replace(DataRange, "  ", " ")

    'End If

    'Delete the temporary sheet.
    Application.DisplayAlerts = False
    wrkSht.Delete
    Application.DisplayAlerts = True

End Sub

添加以单引号开头的字符串到excel单元格

2 个答案: