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

**mlexcelhelpforum** · 07-08-2011, 04:19 AM

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

**Domski** · 07-08-2011, 04:41 AM

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

**TMShucks** · 07-08-2011, 05:02 AM

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

**mlexcelhelpforum** · 07-08-2011, 05:28 AM

Dear Dom,

Thanks for the tip! I checked out the Text to Columns feature. Interesting. I didn't know about it. I'll fiddle with it more later.

Dear TMShucks,

I tried it out, and it worked perfectly! Thank you oh so much!

However, on second thought I realized it would be better to also split the two Chinese words (which are separated by a space in the original column) into their own individual column, so that the end result looks like this:

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

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

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

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

Would it be possible to add in a small section of code somewhere to include that step?

Thank you soooo much!

**TMShucks** · 07-08-2011, 06:11 AM

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

**mlexcelhelpforum** · 07-08-2011, 06:50 AM

Dear TMShucks,

I gave it a shot, and something didn't go quite right. So I went and studied the code, figured out the gist of what it meant and realized that just a small piece needed to be changed into this:


' split chinese words - space separator
Columns("C:C").Insert Shift:=xlToRight
Range("B1:B" & lLR).TextToColumns _

It was probably just a typo on your end, but nevertheless it forced me to have a look at the code now rather than save it for another day and left me feeling slightly capable!

Thanks a lot for the solution!

ML

**TMShucks** · 07-08-2011, 07:40 AM

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