Hỏi cách tách mỗi chữ trong text thành 1 ô

[linhvsb]

Em muốn tạo một macro sao cho khi nhập các chữ vào cột text hoặc paste 1 đoạn text nào đó vào excel thì nó sẽ tự động nhập các từ vào từng ô ở cột A. Những từ đã nhập không trùng nhau.
các anh chị xem thêm file đính kèm ạ.

 

[ChanhTQ@]

Bạn xài tạm macro này

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Union([C7], [C9])) Is Nothing Then
    Const kT As String = " ":               Dim DDai As Integer
    Dim StrC As String, sStr As String
    
    Range("A1:A999").ClearContents
    StrC = Target.Value & kT & "GPE.COM"
    Do
        DDai = InStr(StrC, kT)
        If DDai = 0 Then
            Exit Do
        Else
            sStr = Left(StrC, DDai - 1)
            If Range("A2:A999").Find(sStr, LookIn:=xlFormulas, lookat:=xlWhole) _
                Is Nothing Then
                [A65500].End(xlUp).Offset(1) = sStr
            End If
            StrC = Mid(StrC, DDai + 1)
        End If
    Loop
 End If
End Sub

 

[Po_Pikachu]

Thêm 1 cách lấy dữ liệu trong Clipboard ra để xử lý.
Bạn quét chọn dữ liệu ở ô E2 -> nhấn Ctrl + C để nạp dữ liệu vào Clipboard.
Sau đó chạy Macro Paste (nhấn Alt + F8 -> Run).

Sub Paste()
    Dim MyDataObj As New DataObject
    Dim arr() As String, vitri As Range
    MyDataObj.GetFromClipboard
    k = 0: dem = 0
    arr() = Split(MyDataObj.GetText, " ")
    Set vitri = Application.InputBox("Chon vitri luu:", Type:=8)
    For i = LBound(arr) To UBound(arr)
        For j = i To UBound(arr)
        If arr(j) = arr(i) Then
        dem = dem + 1
        End If
        Next
        If dem = 1 Then
        vitri.Offset(k) = arr(i)
        k = k + 1
        End If
        dem = 0
    Next
End Sub

À, nếu bạn muốn áp dụng code này cho file của bạn thì bạn cần làm thêm bước thiết đặt References. Bạn vào VBA (nhấn Alt + F11) -> vào Tools -> chọn References -> nhấn tiếp vào Browse... -> vào C:\Windows\System32 -> chọn file FM20.DLL -> OK -> OK.
Rồi mới dùng được code trên.
Thân.

 

[hoa35ktxd]

Bổ sung thêm.
Làm nhưa cách của Po_Picachu là ổn rồi, nhưng tôi hay làm như sau, không biết có nhanh hơn so với cách dùng vòng lặp hay không.
Tạo 1 biến A as string trung gian.
Trước khi gán giá trị của mảng vào Cell ta kiểm tra xem giá trị đó có nằm trong A hay không. Nếu chưa có trong A thì gán vào Cell đồng thời gán thêm vào chuỗi A.

If Instr(A,Arr(i))= 0 then
       A= A & " " & Arr(i)
       Cells(K,Cot).value=Arr(i)
       K=K+1
End If

 

[Po_Pikachu]

Ồ, cảm ơn bạn nha!
Cách này cũng hay đấy! Mình chưa học được cách này! Nay lại được mở mang tầm mắt rồi! Cảm ơn bạn 1 lần nữa nha!

Sub Paste()
On Error Resume Next
    Dim MyDataObj As New DataObject
    Dim arr() As String, vitri As Range
    MyDataObj.GetFromClipboard
    K = 0
    arr() = Split(MyDataObj.GetText, " ")
    Set vitri = Application.InputBox("Chon vitri luu:", Type:=8)
    For i = LBound(arr) To UBound(arr)
        If InStr(A, arr(i)) = 0 Then
            A = A & " " & arr(i)
            vitri.Offset(K) = arr(i)
            K = K + 1
        End If
    Next
End Sub

Thân.

 

[hoa35ktxd]

Đó chỉ là cách làm của mỗi người khác nhau thôi.
Cái quan trọng là trong 2 cách làm này, cái nào nhanh hơn cái nào, vì tôi không biết thực chất cái hàm Instr nó làm việc thế nào, chắc là nó cũng phải duyệt qua tất cả các phần tử chuổ̃đee so sánh. Cách của tôi thì nhìn có vẻ gọn hơn nhưng chưa chắc đã nhanh hơn.

 

[linhvsb]

các bác hướng dẫn em cụ thể hơn được không ạ? em đã đọc kĩ hướng dẫn sử dụng trước khi dùng rồi
Ctrl + C -> Alt + F8 trước đó em cũng vào VBA (nhấn Alt + F11) -> vào Tools -> chọn References -> nhấn tiếp vào Browse... -> vào C:\Windows\System32 -> chọn file FM20.DLL -> OK -> OK.
mà sao không được ạ?

 

[Po_Pikachu]

các bác hướng dẫn em cụ thể hơn được không ạ? em đã đọc kĩ hướng dẫn sử dụng trước khi dùng rồi
Ctrl + C -> Alt + F8 trước đó em cũng vào VBA (nhấn Alt + F11) -> vào Tools -> chọn References -> nhấn tiếp vào Browse... -> vào C:\Windows\System32 -> chọn file FM20.DLL -> OK -> OK.
mà sao không được ạ?

Vậy chắc chỉ còn 1 trường hợp là bạn đã chọn High cho Security rồi. Bạn vào Tools (trên bảng tính Excel) -> Macro -> Security -> chọn Low -> OK.
Rồi tắt Excel đi, khởi động lại file và làm lại xem.
Thân.

 

[linhvsb]

em đã cẩn thận để cả Low security rồi đấy chứ ạ.
nhưng khi copy xong, có cửa sổ chọn vitri lưu, em nhấp đại con trỏ vào 1 ô nào đấy ví dụ $A$13 rồi OK mà nó chẳng hiện ra cái củ khoai củ sắn gì cả

 

[cadafi]

Code của Po_Pikachu, mình chạy cũng không được, dù đã thực hiện đúng như hướng dẫn! Không biết tại sao?

 

[hoa35ktxd]

Đoạn code của Picachu tôi test rồi, rất OK, tuy nhiên cần sửa lại đôi chút, tôi nghi có kảh năng do một số biến chưa được khai báo tường minh. Tôi mạn phép sửa lại như sau

Sub Paste()
On Error Resume Next
    Dim MyDataObj As New DataObject
    Dim arr() As String, vitri As Range
    Dim A as String
    Dim K as Interger
    MyDataObj.GetFromClipboard
    K = 0
    arr() = Split(MyDataObj.GetText, " ")
    Set vitri = Application.InputBox("Chon vitri luu:", Type:=8)
    For i = LBound(arr) To UBound(arr)
        If InStr(A, arr(i)) = 0 Then
            A = A & " " & arr(i)
            vitri.Offset(K) = arr(i)
            K = K + 1
        End If
    Next
End Sub

Trước khi chạy bạn phải chắc chắn trong Clipboad vừa mới copy 1 chuỗi duy nhất.
Khi xuất hiện hộp thoại Input hãy dùng chuột để chọn ô bắt đầu chèn, trong hộp input sẽ hiện địa chỉ ô.
Nếu vẫn không được thì đành chịu.

 

[Po_Pikachu]

Code của Po_Pikachu, mình chạy cũng không được, dù đã thực hiện đúng như hướng dẫn! Không biết tại sao?

Bác nói làm không được thì em chịu thua luôn đó.
Bác đã từng có bài đăng vấn đề này rồi mà! Em chỉ đăng lại thôi chứ có thay đổi gì đâu. Bác xem ở link này: http://www.giaiphapexcel.com/forum/showthread.php?t=12396
Thân.

 

[cadafi]

Bác nói làm không được thì em chịu thua luôn đó.
Bác đã từng có bài đăng vấn đề này rồi mà! Em chỉ đăng lại thôi chứ có thay đổi gì đâu. Bác xem ở link này: http://www.giaiphapexcel.com/forum/showthread.php?t=12396
Thân.

Chính vì vậy mà mình mới nói, loay hoay nãy giờ mà không biết lý do tại sao? Copy xong. ấn alt+F8 --> chạy code, không thấy ra kết quả gì cả!
Mình thử bỏ chỗ GetFromClipboard thì code chạy OK, như sau:
[highlight=vb]
Sub mPaste()
On Error Resume Next
'Dim MyDataObj As New DataObject
Dim arr() As String, vitri As Range
Dim A As String, K As Integer
'MyDataObj.GetFromClipboard
K = 0
arr() = Split([H5], " ")
Set vitri = Application.InputBox("Chon vitri luu:", Type:=8)
For i = LBound(arr) To UBound(arr)
If InStr(A, arr(i)) = 0 Then
A = A & " " & arr(i)
vitri.Offset(K) = arr(i)
K = K + 1
End If
Next
End Sub
[/highlight]
Nghĩa là code trên chạy trên máy mình thì không lấy dữ liệu từ Clipboard ra được, mặc dù đã đăng ký MicroSoft Forms 2.0 Object Library (file FM20.DLL).
Anh chị nào rành về vấn đề này xin chỉ giúp!

 

[cadafi]

Thử bẫy một chỗ nữa như sau:
[highlight=vb]
Sub mPaste()
'On Error Resume Next
Dim MyDataObj As New MSForms.DataObject '<== Thêm chỗ này MSForms
Dim Arr() As String, ViTri As Range
Dim A As String, jK As Integer, mText as String
MyDataObj.GetFromClipboard
mText = MyDataObj.GetText
arr() = Split(mText, Space(1))
jK = 0
Set ViTri = Application.InputBox("Chon vitri luu:", Type:=8)
For i = LBound(Arr) To UBound(Arr)
If InStr(A, Arr(i)) = 0 Then
A = A & " " & Arr(i)
ViTri.Offset(jK) = Arr(i)
jK = jK + 1
End If
Next i
End Sub
[/highlight]

Chạy cũng không được luôn! Nó báo lỗi như sau:

Debug thì nó ra như thế này:

Trong khi việc đăng ký Reference đã hoàn tất:

Như vậy, chạy không được là do lỗi gì!? Anh em biết xin hỗ trợ giúp!

 

[Po_Pikachu]

Cái ô vuông đó đúng là Alt + Enter nhưng dữ liệu ở đây là Text mà đâu phải từng hàng dọc đâu?
Bác copy dữ liệu theo cột trong Notepad thì sẽ xuất hiện thêm dấu ░ kia nữa.
Nếu vậy bác phải Replace cái ô ⌐ kia đi trước khi Split đi.
Thân.

 

[linhvsb]

Trước khi chạy bạn phải chắc chắn trong Clipboad vừa mới copy 1 chuỗi duy nhất.
Khi xuất hiện hộp thoại Input hãy dùng chuột để chọn ô bắt đầu chèn, trong hộp input sẽ hiện địa chỉ ô.

bác cho em hỏi làm thế nào mà biết được nó đã chắc chắn nằm trong Clipboad ạ?
Code bác cho em test mỏi tay cũng vẫn báo lỗi ạ.

 

[cadafi]

bác cho em hỏi làm thế nào mà biết được nó đã chắc chắn nằm trong Clipboad ạ?
Code bác cho em test mỏi tay cũng vẫn báo lỗi ạ.

Cái đó không khó, do chính tả thôi bạn à! bạn sửa Interger thành Integer là xong thôi! Cái của mình mới quan trọng!

 

[Po_Pikachu]

Bổ sung code chạy trường hợp có cái ô vuông (⌐) Alt + Enter đây.
[highlight=vb]Sub mPaste()
'On Error Resume Next
Dim MyDataObj As New MSForms.DataObject '<== Thêm ch? này MSForms
Dim Arr() As String, ViTri As Range
Dim A As String, jK As Integer, mText As String
MyDataObj.GetFromClipboard
mText = MyDataObj.GetText
If InStr(1, mText, Chr(10)) <> 0 Then
Arr() = Split(mText, Chr(10))
For i = LBound(Arr) To UBound(Arr) 'Cai nay em chua hieu tai sao lai ko bo duoc
Arr(i) = Left(Arr(i), Len(Arr(i)) + (UBound(Arr) <> i))
Next
Else
Arr() = Split(mText, Space(1))
End If
jK = 0
Set ViTri = Application.InputBox("Chon vitri luu:", Type:=8)
For i = LBound(Arr) To UBound(Arr)
If InStr(A, Arr(i)) = 0 Then
A = A & " " & Arr(i)
ViTri.Offset(jK) = Arr(i)
jK = jK + 1
End If
Next i
End Sub[/highlight]
Bác thử chạy trên file của em không xem có được không? Nếu vẫn không được thì chắc do Excel đã khóa gì rồi. Còn được thì thằng FM20.DLL có vấn đề rồi. Còn tình huống khác thì em chưa tìm ra.
Thân.

 

[linhvsb]

không biết có bác nào bị lỗi như em không thay vì QUÉT ô dữ liệu
như bác Pikachu bẩu thì em lại cứ tương vào ô có dữ liệu mà
Ctrl + C thế nên nó mới không ra.
Giờ thì Ok rồi ạ. Cảm ơn các bác nhiều.

Cho em hỏi nếu em không cần phân biệt chữ in hoa và chữ thường
VD nếu có 2 chữ Nước và nước thì chỉ cần nhập 1 chữ nước thôi.

Trường hợp nữa là chữ tách ra từ đoạn text nếu đã trùng với chữ có trong cột
chọn làm vị trí lưu thì cũng không cần nhập lại.

và nếu sau chữ có dấu chấm, phẩy, chấm than, hỏi chấm, ba chấm v.v...
thì cũng không cần lưu những kí tự này.
thì phải làm thế nào ạ?

 

[Po_Pikachu]

không biết có bác nào bị lỗi như em không thay vì QUÉT ô dữ liệu
như bác Pikachu bẩu thì em lại cứ tương vào ô có dữ liệu mà
Ctrl + C thế nên nó mới không ra.
Giờ thì Ok rồi ạ. Cảm ơn các bác nhiều.

Cho em hỏi nếu em không cần phân biệt chữ in hoa và chữ thường
VD nếu có 2 chữ Nước và nước thì chỉ cần nhập 1 chữ nước thôi.

Trường hợp nữa là chữ tách ra từ đoạn text nếu đã trùng với chữ có trong cột
chọn làm vị trí lưu thì cũng không cần nhập lại.

và nếu sau chữ có dấu chấm, phẩy, chấm than, hỏi chấm, ba chấm v.v...
thì cũng không cần lưu những kí tự này.
thì phải làm thế nào ạ?

Thứ nhất, cái không phân biệt chữ hoa chữ thường thì được. Nhưng bạn chọn chữ nào?

Thứ hai, nếu chữ tách ra từ đoạn text mà có trong cột thì đâu có sau đâu. Nó chỉ chép đè lên thôi, đâu có ảnh hưởng gì.

Còn việc có các dấu kia thì bạn còn cần những dấu đó nữa không? Và bạn muốn xóa những loại dấu nào? Vì có khá nhiều dấu đó. Mà bạn liệt kê vậy hết các trường hợp chưa. Ví dụ: Spi-cots pi-dog plain-spoken
Vậy bỏ dấu đi thì nó không có nghĩa thì sao?
Bạn nên xét lại xem cần bỏ những dấu gì cho công việc của bạn nha!
Thân.