Cut/Paste Parts of Strings from one Column to Other Columns

Hello,

I have a dictionary file in excel. Only the first column is filled with data entries, which look exactly like this, but with many more entries:

1st row: 一局 一局 [yi1 ju2] /inning/
2nd row: 一層 一层 [yi1 ceng2] /layer/
3rd row: 一巴掌 一巴掌 [yi1 ba1 zhang3] /a slap/a spank/

The desired end result is:

1st Column
1st row: 一局 一局
2d row: 一層 一层
3rd row: 一巴掌 一巴掌

2nd Column
1st row: yi1 ju2
2d row: yi1 ceng2
3rd row: yi1 ba1 zhang3

3rd Column
1st row: inning
2d row: layer
3rd row: a slap, a spank

The problem is I don't know how to specify and manipulate elements of the strings.

Thank you kindly for any assistance!

ML

Try using Text To Columns. Use [ as the delimiter first time and ] the second time. The rest you should be able to clean up using Find and Replace.

Dom

Try this for a starter:

Option Explicit

Sub Conversion()
'
Dim lLR As Long ' Last Row
lLR = Range("A1").End(xlDown).Row

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Range("A1:A" & lLR).TextToColumns _
    Destination:=Range("B1"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, _
    Semicolon:=False, _
    Comma:=False, _
    Space:=False, _
    Other:=True, OtherChar:="[", _
    FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True

Range("C1:C" & lLR).TextToColumns _
    Destination:=Range("C1"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, _
    Semicolon:=False, _
    Comma:=False, _
    Space:=False, _
    Other:=True, _
    OtherChar:="]", _
    FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True

Application.DisplayAlerts = True

With Range("E1:E" & lLR)
    .FormulaR1C1 = _
        "=SUBSTITUTE(MID(RC[-1],3,LEN(RC[-1])-3),""/"","", "")"
    .Value = .Value
End With

Columns(4).Delete
Range("A:D").EntireColumn.AutoFit
'Columns(1).Delete  'un-comment this line after testing

Application.ScreenUpdating = True

End Sub

If it looks OK, you can un-comment the line: "Columns(1).Delete"



Regards

Seeing as you asked so nicely ...

Sub Conversion2()
'
Dim lLR As Long ' Last Row
lLR = Range("A1").End(xlDown).Row

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' first split [
Range("A1:A" & lLR).TextToColumns _
    Destination:=Range("B1"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Space:=False, _
    Other:=True, OtherChar:="[", _
    FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True

' second split ]
Range("C1:C" & lLR).TextToColumns _
    Destination:=Range("C1"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Space:=False, _
    Other:=True, OtherChar:="]", _
    FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True

Application.DisplayAlerts = True

' lose the slashes and insert comma(s)
With Range("E1:E" & lLR)
    .FormulaR1C1 = _
        "=SUBSTITUTE(MID(RC[-1],3,LEN(RC[-1])-3),""/"","", "")"
    .Value = .Value
End With

' delete interim column
Columns(4).Delete

' split chinese words - space separator
Columns("C:C").Insert Shift:=xlToRight
Range("B1:B3").TextToColumns _
    Destination:=Range("B1"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=True, _
    Space:=True, _
    Other:=False, _
    FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True

Range("A:E").EntireColumn.AutoFit
'Columns(1).Delete  'un-comment this line after testing

Application.ScreenUpdating = True

End Sub

but no more ;-)


Regards

You are absolutely right, well spotted ... sadly, it *was* my error.

Not a typo, as such. I often record a macro to get the base code and then generalise it. That's what I did here just to make sure what I wanted to do worked correctly. Of course, I was only working with three rows so I didn't notice a problem. What I forgot to do was apply the edit which you have quite correctly put in.

Anyway, it's maybe helped you down the learning curve so every cloud has a silver lining.

Thanks for the rep.

Regards