Macro Text to column in selected range.

[bugatino]

Chào các bạn GPE.
Mình muốn tách dữ liệu trong 1 cell được phân tách bởi dấu ";" ra thành nhiều cột riêng. Nhưng chức năng Text to column của excel chỉ cho phép mình chọn 1 column mỗi lần tách và nếu cột ngay bên phải của cột cần tách có dữ liệu thì nó sẽ ghi đè dữ liệu lên cột này. Mình muốn viết một Macro để tách dữ liệu ra thành nhiều cột riêng biệt trong một Range do mình chọn và nó tự thêm cột vào ngay bên phải cột cần tách để không ghi đè dữ liệu lên ô có sẵn thì làm thế nào? Mong các bạn giúp đỡ.
* Dữ liệu tham khảo file excel đính kèm.

 

[hoangvuluan]

Thử với macro sau:

Sub Text2Columns()
Const kt = ";" 'ky tu phan cach nhom'
Dim ra As Range, ce As Range, iR As Long, i As Long, st As String, m As Long, t As Long, ar()
With Application
.ScreenUpdating = False
.EnableEvents = False
Set ra = Selection
    'neu chon nhieu vung thi chi lay vung dau tien'
    If ra.Areas.Count > 1 Then Set ra = ra.Areas(1)
    'eu chon nhieu cot thi chi lay cot dau tien'
    Set ra = ra.Resize(, 1)
    iR = ra.Rows.Count
    ReDim ar(1 To iR)
    m = 0
    For i = 1 To iR
        st = ra(i, 1).Text
        ar(i) = Len(st) - Len(Replace(st, kt, ""))
        m = IIf(ar(i) > m, ar(i), m)
    Next
    
    If m > 0 Then
        m = m + 1
        ra.Offset(, 1).Resize(, m).EntireColumn.Insert
        For i = 1 To iR
            ra.Offset(i - 1, 1).Resize(1, ar(i) + 1) = Split(ra(i, 1), kt)
        Next
    End If
    Set ra = Nothing
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Macro cho phép chọn một vùng liên tiếp trên 1 cột, khi thực hiện sẽ căn cứ vào ô có chưa nhiều dấu ; nhất để tách cột cho đúng.

 

[bugatino]

Cám ơn thầy hoangvuluan, em đã thử macro thầy gửi. Nhưng bị lỗi ở đoạn:

[COLOR=#0000BB][FONT=monospace]ra[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Offset[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i [/FONT][/COLOR][COLOR=#007700][FONT=monospace]- [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ar[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) + [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Split[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ra[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]kt[/FONT][/COLOR][COLOR=#007700][FONT=monospace])[/FONT][/COLOR]

Thầy có thể xem lại giúp em được không ah?
Em đã xem qua Macro của thầy, hình như chỉ tách cột đầu tiên nếu chọn nhiều cột 1 lúc. Mục đích của em là chọn nhiều cột 1 lúc, sau đó nó tự check dữ liệu theo từng cột, sẽ thêm số lượng cột theo ô có nhiều ký tự ";" nhất vào bên phải ô cần tách sau đó tách dữ liệu từ ô này ra. Cứ như thế cho tới hết số cột trong range mà mình chọn.

 

[Ba Tê]

Cám ơn thầy hoangvuluan, em đã thử macro thầy gửi. Nhưng bị lỗi ở đoạn:

[COLOR=#0000BB][FONT=monospace]ra[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Offset[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i [/FONT][/COLOR][COLOR=#007700][FONT=monospace]- [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ar[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) + [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Split[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ra[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]kt[/FONT][/COLOR][COLOR=#007700][FONT=monospace])[/FONT][/COLOR]

Thầy có thể xem lại giúp em được không ah?
Em đã xem qua Macro của thầy, hình như chỉ tách cột đầu tiên nếu chọn nhiều cột 1 lúc. Mục đích của em là chọn nhiều cột 1 lúc, sau đó nó tự check dữ liệu theo từng cột, sẽ thêm số lượng cột theo ô có nhiều ký tự ";" nhất vào bên phải ô cần tách sau đó tách dữ liệu từ ô này ra. Cứ như thế cho tới hết số cột trong range mà mình chọn.

Thử với Sub này xem, kết quả ở Sheet2.

Public Sub GPE()
Application.DisplayAlerts = False
Dim Rng(), Arr(), I As Long, J As Long, Tem As String
        Rng = Sheet1.Range("A1:Z100").Value
    ReDim Arr(1 To UBound(Rng, 1), 1 To 1)
    For I = 1 To UBound(Rng, 1)
        Tem = ""
        For J = 1 To UBound(Rng, 2)
            If Rng(I, J) <> "" Then
                Tem = Tem & ";" & Rng(I, J)
                Arr(I, 1) = Mid(Tem, 2, Len(Tem) - 1)
            End If
        Next J
    Next
Sheet2.Select
    [A1].Resize(I - 1).Value = Arr
    Range([A1], [A65000].End(xlUp)).Select
        Selection.TextToColumns Destination:=Range("A1"), Other:=True, OtherChar:=";"
Application.DisplayAlerts = False
End Sub

 

[hoangvuluan]

Cám ơn thầy hoangvuluan, em đã thử macro thầy gửi. Nhưng bị lỗi ở đoạn:

[COLOR=#0000bb][FONT=monospace]ra[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]Offset[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]i [/FONT][/COLOR][COLOR=#007700][FONT=monospace]- [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]ar[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]i[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) + [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]Split[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]ra[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]i[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000bb][FONT=monospace]kt[/FONT][/COLOR][COLOR=#007700][FONT=monospace])[/FONT][/COLOR]

Thầy có thể xem lại giúp em được không ah?
Em đã xem qua Macro của thầy, hình như chỉ tách cột đầu tiên nếu chọn nhiều cột 1 lúc. Mục đích của em là chọn nhiều cột 1 lúc, sau đó nó tự check dữ liệu theo từng cột, sẽ thêm số lượng cột theo ô có nhiều ký tự ";" nhất vào bên phải ô cần tách sau đó tách dữ liệu từ ô này ra. Cứ như thế cho tới hết số cột trong range mà mình chọn.

Hix, sao tôi test trên máy tính của tôi thì không có lỗi nhỉ - bạn nói rõ vì sao nó lỗi được không? (lúc xảy ra lỗi thì bạn đang chọn cái gì???)

 

[bugatino]

Chào thầy hoangvuluan, em xin mô tả thao tác em đã làm như sau:
Mở file Text to column em gửi attack lên GPE, nhấn Alt+F11, insert thêm 1 module vào Workbook Text to column. Ẩn cửa sổ VBA xuống, quay lại cửa sổ làm việc excel. Tiến hành chọn 1 cột, vào tab Develop trên Ribbon, vào mục macro chọn và run macro Text2Columns của thầy viết. Nó chạy 1 lúc, rồi hiện ra cửa sổ thông báo lỗi :

Run-time error '1004':
Application-defined or object-defined error.

Em nhấn debug thì có dấu chỉ màu vàng vào dòng:

ra.Offset(i - 1, 1).Resize(1, ar(i) + 1) = Split(ra(i, 1), kt)

như em báo với thầy bên trên.
Em đang dùng Excel 2010. Mong thầy xem và giúp em ah.
Cám ơn thầy.

 

[bugatino]

Em xin được sửa lại macro của bác Ba Tê cho phù hợp hơn mới mục đích của em như sau:

Public Sub GPE()
Application.DisplayAlerts = False
Dim Rng(), Arr(), I As Long, J As Long, Tem As String
        Rng = Selection.Value
    ReDim Arr(1 To UBound(Rng, 1), 1 To 1)
    For I = 1 To UBound(Rng, 1)
        Tem = ""
        For J = 1 To UBound(Rng, 2)
            If Rng(I, J) <> "" Then
                Tem = Tem & ";" & Rng(I, J)
                Arr(I, 1) = Mid(Tem, 2, Len(Tem) - 1)
            End If
        Next J
    Next
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Splited"
    [A1].Resize(I - 1).Value = Arr
    Range([A1], [A65000].End(xlUp)).Select
        Selection.TextToColumns Destination:=Range("A1"), Other:=True, OtherChar:=";"
Application.DisplayAlerts = False
End Sub

Thay vì sử dụng fix range A1:Z100 em đổi lại thành Selection là range mà mình chọn bằng chuột. Và đoạn Sheet2.Select em đổi lại là tạo thêm 1 sheet mới và cuối cùng của WorkBook với tên là Splited. Cám ơn bác về Macro tuyệt vời này.

Bác cho em hỏi thêm chút, nếu em muốn Macro của em chạy như sau:
Chọn 1 range gồm nhiều cột muốn tách ra. Sau đó nó check từng cột trong range đó. Tìm ô có số lượng ký tự ";" lớn nhất và thêm vào ngay bên phải nó số cột = số ký tự ";" nó tìm được lớn nhất của cột và tiến hành tách dữ liệu vào các cột vừa thêm đó sau đó lại nhảy sang cột tiếp theo, lại check và làm như vậy tới hết số lượng cột trong range thì làm thế nào ah?