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ị.
.................................
Lỗi Macro
Excel 2010 không có lệnh này thì phải.bạn tìm hiểu về hàm split nhé.
Đó 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. Thanks1/ 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ễ.
Split là hàm trong VBA í bạnExcel 2010 không có lệnh này thì phải.
Cám ơn anh. Đúng nhưng còn thiếu 2 bước: di chuyển đến ô D1 và pass dữ liệu Ctr V (có sẵn trong bộ nhớ) rồi mới thực hiện lệnh tách như của anh. Anh giúp mình thêm 2 bước trên với. Cám ơn.Thử cái này coi thế nào
Chưa hiểu ý bạn lắmCám ơn anh. Đúng nhưng còn thiếu 2 bước: di chuyển đến ô D1 và pass dữ liệu Ctr V (có sẵn trong bộ nhớ) rồi mới thực hiện lệnh tách như của anh. Anh giúp mình thêm 2 bước trên với. Cám ơn.
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ư sauChà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?
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, TrailingMinusNumbers:=True
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ưa hiểu ý bạn lắm
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ê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
Sửa codeThê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
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
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
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
mình gộp được rồi. Bài toán đã hoàn thành. Cám ơn nhiều.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
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ỗ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
Selection.TextToColumns ...............
Trong tình huống này thì đúng là D1. Nhưng để khỏi "lăn tăn" thì dùngChà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ỗ
Khi D1 được paste vào thì nó selection sẽ là ô D1 ạ chú?Mã:Selection.TextToColumns ...............
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