Tạo macro Cover Text To Columns (3 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

ngoctruong1421

Thành viên mới
Tham gia
14/8/21
Bài viết
12
Được thích
3
Chào anh chị. Cho em hỏi: Tạo macro Cover Text To Columns (đặt phím tắt Ctrl+q) dữ liệu sau khi tách ra hơn 1000 ô (bằng Record Macro) thì báo lỗi. Hiện tại em đang làm thủ công như sau: Vào ô D1 thực hiện Ctr+V, Alt A E F. Vậy có cách nào để thực hiện nhanh không vậy? Cám ơn các anh chị.

1629868497067.png

1629868510375.png

1629868529300.png
1629868547158.png

Lỗi Macro
1629868570086.png
 

File đính kèm

Chào anh chị. Cho em hỏi: Tạo macro Cover Text To Columns (đặt phím tắt Ctrl+q) dữ liệu sau khi tách ra hơn 1000 ô (bằng Record Macro) thì báo lỗi. Hiện tại em đang làm thủ công như sau: Vào ô D1 thực hiện Ctr+V, Alt A E F. Vậy có cách nào để thực hiện nhanh không vậy? Cám ơn các anh chị.
.................................
Lỗi Macro

1/ Tôi thắc mắc dữ liệu chỉ lập đi lập lại có mấy chữ thế này bc d c, mà bạn tách ra để làm gì?
2/ Bài toán đơn giản nhất là Format Cells, chọn Wrap text > OK để cho nó nằm gọn trong 1 Cell rồi chọn khúc giữa Alt+ 2 lần Enter, rồi Cắt một nữa (xem hình) sang Cell khác rồi tách thì quá dễ.
 

File đính kèm

  • A_Chia.JPG
    A_Chia.JPG
    163.7 KB · Đọc: 9
bạn tìm hiểu về hàm split nhé.
Excel 2010 không có lệnh này thì phải.
Bài đã được tự động gộp:

1/ Tôi thắc mắc dữ liệu chỉ lập đi lập lại có mấy chữ thế này bc d c, mà bạn tách ra để làm gì?
2/ Bài toán đơn giản nhất là Format Cells, chọn Wrap text > OK để cho nó nằm gọn trong 1 Cell rồi chọn khúc giữa Alt+ 2 lần Enter, rồi Cắt một nữa (xem hình) sang Cell khác rồi tách thì quá dễ.
Đó là 1 phần của lệnh cần làm thôi vì còn nhiều thao tác khác nữa. Thanks
 
Chào anh chị. Cho em hỏi: Tạo macro Cover Text To Columns (đặt phím tắt Ctrl+q) dữ liệu sau khi tách ra hơn 1000 ô (bằng Record Macro) thì báo lỗi. Hiện tại em đang làm thủ công như sau: Vào ô D1 thực hiện Ctr+V, Alt A E F. Vậy có cách nào để thực hiện nhanh không vậy?
Nếu vẫn cố tình dùng TextToColumns thì phần TextToColumns của bạn thử sửa thành ngắn gọn như sau
Mã:
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, TrailingMinusNumbers:=True

Tức
Mã:
Sub test()
    With ThisWorkbook.Worksheets("DAU VAO")
        .Range("E6").Copy
        .Range("D1").PasteSpecial xlPasteValues
    End With
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, TrailingMinusNumbers:=True
End Sub
 
Lần chỉnh sửa cuối:

Thêm bước pase dữ liệu vào thì ô D1, thì ô D1 mới có dữ liệu sau đó mới thực hiện việc tách dữ liệu của anh đã làm.
Có nghĩa là:
Ô D1 đang là ô trống chưa có dữ liệu
Bước 1: di chuyển đến ô D1
Bước 2: Paste dữ liệu ra.
Xong 2 bước này thì mới thực hiện các lệnh tách mà anh đã làm. Thanks



1629886282971.png
 
Thêm bước pase dữ liệu vào thì ô D1, thì ô D1 mới có dữ liệu sau đó mới thực hiện việc tách dữ liệu của anh đã làm.
Có nghĩa là:
Ô D1 đang là ô trống chưa có dữ liệu
Bước 1: di chuyển đến ô D1
Bước 2: Paste dữ liệu ra.
Xong 2 bước này thì mới thực hiện các lệnh tách mà anh đã làm. Thanks



View attachment 264731
Cái đó bạn thao tác đưa dữ liệu ở ngoài vào bằng tay cũng tốn bao nhiêu thời gian đâu.
 
Thế thử như bài #9 có được không?
 
Lần chỉnh sửa cuối:
Thêm bước pase dữ liệu vào thì ô D1, thì ô D1 mới có dữ liệu sau đó mới thực hiện việc tách dữ liệu của anh đã làm.
Có nghĩa là:
Ô D1 đang là ô trống chưa có dữ liệu
Bước 1: di chuyển đến ô D1
Bước 2: Paste dữ liệu ra.
Xong 2 bước này thì mới thực hiện các lệnh tách mà anh đã làm. Thanks
Sửa code
Mã:
Sub Tach_DL()
    Dim arr, res(), t
    Sheet1.Range("D1").PasteSpecial xlPasteAll
    Sheet1.Rows("3:3").ClearContents
    If Len(Sheet1.Range("D1").Value) > 2 Then
        t = Sheet1.Range("D1").Value
    Else
        Exit Sub
    End If
    arr = Split(t, " ")
    Sheet1.Range("A3").Resize(, UBound(arr)+1).Value = arr
    Sheet1.Range("D1").ClearContents
End Sub

còn nếu dữ liệu từ E5 thì thêm sửa code
Mã:
Sub Tach_DL()
    Dim arr, res(), t
    With Sheet1
        .Range("E5").Copy .Range("D1")
        .Rows("3:3").ClearContents
        If Len(.Range("D1").Value) > 2 Then
            t = .Range("D1").Value
        Else
            Exit Sub
        End If
        arr = Split(t, " ")
        .Range("A3").Resize(, UBound(arr)+1).Value = arr
        .Range("D1").ClearContents
    End With
End Sub
 
Lần chỉnh sửa cuối:
Thế thử như bài #9 có được không?
 
Lần chỉnh sửa cuối:
Sửa code
Mã:
Sub Tach_DL()
    Dim arr, res(), t
    Sheet1.Range("D1").PasteSpecial xlPasteAll
    Sheet1.Rows("3:3").ClearContents
    If Len(Sheet1.Range("D1").Value) > 2 Then
        t = Sheet1.Range("D1").Value
    Else
        Exit Sub
    End If
    arr = Split(t, " ")
    Sheet1.Range("A3").Resize(, UBound(arr)+1).Value = arr
    Sheet1.Range("D1").ClearContents
End Sub

còn nếu dữ liệu từ E5 thì thêm sửa code
Mã:
Sub Tach_DL()
    Dim arr, res(), t
    With Sheet1
        .Range("E5").Copy .Range("D1")
        .Rows("3:3").ClearContents
        If Len(.Range("D1").Value) > 2 Then
            t = .Range("D1").Value
        Else
            Exit Sub
        End If
        arr = Split(t, " ")
        .Range("A3").Resize(, UBound(arr)+1).Value = arr
        .Range("D1").ClearContents
    End With
End Sub

Gần đúng ý thôi anh, Ô E5 là ô để lấy dữ liệu cho ví dụ thôi.
Có nghĩa là:
Ô D1 đang là ô trống chưa có dữ liệu
Bước 1: di chuyển đến ô D1
Bước 2: Paste dữ liệu ra.
Xong 2 bước này thì mới thực hiện các lệnh tách mà anh đã làm. Thanks.

Bài toán này: là thực hiện 2 Macro: copyvaoD1 và tach_DL. Anh gộp chúng thành 1 Macro là hoàn thành. Thanks
 

File đính kèm

Lần chỉnh sửa cuối:
Gần đúng ý thôi anh, Ô E5 là ô để lấy dữ liệu cho ví dụ thôi.
Có nghĩa là:
Ô D1 đang là ô trống chưa có dữ liệu
Bước 1: di chuyển đến ô D1
Bước 2: Paste dữ liệu ra.
Xong 2 bước này thì mới thực hiện các lệnh tách mà anh đã làm. Thanks.

Bài toán này: là thực hiện 2 Macro: copyvaoD1 và tach_DL. Anh gộp chúng thành 1 Macro là hoàn thành. Thanks
mình gộp được rồi. Bài toán đã hoàn thành. Cám ơn nhiều.
 
Bài #13, #15 phải là "Thế thử như bài #9 có được không?"

Đã sửa lại 2 bài.
 
Nếu vẫn cố tình dùng TextToColumns thì phần TextToColumns của bạn thử sửa thành ngắn gọn như sau
Mã:
Sub test()
    With ThisWorkbook.Worksheets("DAU VAO")
        .Range("E6").Copy
        .Range("D1").PasteSpecial xlPasteValues
    End With
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, TrailingMinusNumbers:=True
End Sub
Chào chú. con test thấy code của chú chạy ngon lành. Chỉ đang thắc mắc là cái chỗ
Mã:
Selection.TextToColumns ...............
Khi D1 được paste vào thì nó selection sẽ là ô D1 ạ chú?
 
Chào chú. con test thấy code của chú chạy ngon lành. Chỉ đang thắc mắc là cái chỗ
Mã:
Selection.TextToColumns ...............
Khi D1 được paste vào thì nó selection sẽ là ô D1 ạ chú?
Trong tình huống này thì đúng là D1. Nhưng để khỏi "lăn tăn" thì dùng
Mã:
Sub test()
    With ThisWorkbook.Worksheets("DAU VAO")
        .Range("E6").Copy
        .Range("D1").PasteSpecial xlPasteValues
        .Range("D1").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
                            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
                            Semicolon:=False, Comma:=False, Space:=True, Other:=False, TrailingMinusNumbers:=True
    End With
End Sub
 
Web KT

Bài viết mới nhất

Back
Top Bottom