Excelをセルに一重引用符で始まる文字列を追加する

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

2番目の単語'R'は、細胞内のR」になっているがスペースを区切り文字としてExcelで列を作成する機能では、この単語はセル内でのみ「R」となります。

最初に一重引用符を追加した場合'' R '問題は解決しますが、これはデータの後続処理に影響する可能性があります。

周辺には方法がありますか？

Answer 1

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 

戻り値この：

falseに言葉とConsecutiveDelimiterセットの間に余分なスペースで、それはこの返します

このコードのブロックを使用すると、テキスト文字列を渡すことができます手順、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 

Answer 2

私はあなたと

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

の下に置き換える "KIDS" のような "KIDS 'R' KIDS"、 " 'R'"、 "KIDS"

を希望仮定

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は最初の "'"が特殊文字であるとみなして削除します。