Cần giúp đỡ về việc ghép các chuôi kí tự giống nhau thành 1 chuỗi trong Excel

[ngochoang7978]

Vẫn dùng cách loại trừ chuỗi ngắn.
Viết lại code

<div class="bbcode_container">
<div class="bbcode_description">Code:

</div>
</div>
Tôi thử code của bạn toàn lỗi.
Nếu được bạn thử test với dữ liệu trong file xem. Dữ liệu được tạo ngẫu nhiên.

[mevabe]

Tôi thử code của bạn toàn lỗi.
Nếu được bạn thử test với dữ liệu trong file xem. Dữ liệu được tạo ngẫu nhiên.

Không biết là nguyên nhân gì, máy tôi chạy bình thường.
Gửi bạn file xem thử ( Chỉ để biết là code không bị vấp, kết quả không bàn đến )

Tôi thì lại nghĩ thuật toán là nhân tố chính quyết định tốc độ. Nếu không, theo bạn thuật toán tốt hay không tốt người ta đánh giá trên góc độ nào?

Việc kết luận như câu này của bạn thì hoàn toàn đồng ý
Có lẽ là theo thói quen viết code của từng người vậy.

Thân chào!

[annguyen]

-------------
Gửi file đính kèm

[haohiep.hoang@gmail.com]

Tôi thử code của bạn toàn lỗi.
Nếu được bạn thử test với dữ liệu trong file xem. Dữ liệu được tạo ngẫu nhiên.

Tôi test code của cả 2 thấy đều chạy mượt mà, thời gian của 2 code chênh lệch nhau ko đáng kể.

[trananh607]

[IMG]images/smilies/a41.gif[/IMG] Cám ơn anh nhiều lắm ạ. Nhờ anh mà em tiết kiệm được 1 đống thời gian làm việc đó ạ . Cám ơn anh nhiều [IMG]images/smilies/a44.gif[/IMG][IMG]images/smilies/a44.gif[/IMG][IMG]images/smilies/a44.gif[/IMG]

Tôi thấy thuật toán của bạn gtri chưa ổn. Bạn thử với dữ liệu như sau sẽ thấy nhiều chỗ có vấn đề:

Tác giả
Tác phẩm của Giải pháp Excel
Tác phẩm
của
Giải pháp
Excel

Ngoài ra, với dữ liệu lớn thì dùng thuật toán trên sẽ rất chậm, có thể đơ Excel máy luôn.

Nếu là tôi thì tôi dùng thuật toán như sau:
- Sắp xếp dữ liệu đầu vào theo thứ tự từ chuỗi dài nhất đến chuỗi ngắn nhất
- Duyệt qua dữ liệu (từ chuỗi dài đến chuỗi ngắn) Dùng hàm Filter lọc mảng kết quả với điều kiện lần lượt là từng từ trong câu, có kế thừa kết quả lọc của các từ trong một câu. Nếu sau khi lọc hết các từ trong câu mà mảng kết quả lọc không có phần tử nào thì ghi câu đó vào mảng kết quả.

Giải thích thì hơi lòng vòng khó hiểu. Đây là code:

Sub Loc()Dim ArrData, ArrWord() As String, ArrTmp1() As Long, i As Long, j As Long, StrTmp As String, LngTmp As LongArrData = Range([A1], [A65536].End(xlUp)).ValueReDim ArrTmp1(1 To UBound(ArrData, 1))For i = 1 To UBound(ArrData, 1)    ArrData(i, 1) = Application.WorksheetFunction.Trim(ArrData(i, 1))    ArrTmp1(i) = Len(ArrData(i, 1))NextFor i = 1 To UBound(ArrTmp1, 1) - 1    For j = i + 1 To UBound(ArrTmp1, 1)        If ArrTmp1(i) < ArrTmp1(j) Then            StrTmp = ArrData(i, 1):  ArrData(i, 1) = ArrData(j, 1): ArrData(j, 1) = StrTmp            LngTmp = ArrTmp1(i):  ArrTmp1(i) = ArrTmp1(j): ArrTmp1(j) = LngTmp        End If    NextNextErase ArrTmp1Dim ArrTmp2() As StringDim ArrResult() As StringReDim ArrResult(1 To 1)ArrResult(1) = " " & ArrData(1, 1) & " "LngTmp = 1For i = 2 To UBound(ArrData, 1)    If ArrData(i, 1) <> "" Then        ArrWord = Split(ArrData(i, 1), " ")        For j = LBound(ArrWord, 1) To UBound(ArrWord, 1)            ArrTmp2 = Filter(ArrResult, " " & ArrWord(j) & " ", True, vbTextCompare)            If UBound(ArrTmp2, 1) = -1 Then                LngTmp = LngTmp + 1                ReDim Preserve ArrResult(1 To LngTmp)                ArrResult(LngTmp) = " " & ArrData(i, 1) & " "                Exit For            End If        Next    End IfNext[D:D].ClearContents[D1].Resize(LngTmp).Value = Application.WorksheetFunction.Transpose(ArrResult)End Sub  

[vthao93hp]

Tôi thấy thuật toán của bạn gtri chưa ổn. Bạn thử với dữ liệu như sau sẽ thấy nhiều chỗ có vấn đề:
Ngoài ra, với dữ liệu lớn thì dùng thuật toán trên sẽ rất chậm, có thể đơ Excel máy luôn.

ok.
code bị lỗi 2 chỗ

câu lệnh này--->Tam = Split(DL(r, 1), " ") phải đặt trong vòng lặp for rw

câu lệnh này thiếu chặn chuỗi--->If InStr(UCase(DL(rw, 1)), UCase(Tam(c))) Then

Trong sub cũng chưa loại các dữ liệu rỗng nên sẽ bị chậm

---
Thực ra thuật toán của tôi và bạn có lẽ chỉ là ngược cách tính
- Theo hướng của bạn là kiểm tra chuỗi dài tới ngắn và lấy chuỗi có độ dài lớn và nhiều phần tử nhất có thể
- Theo hướng của tôi thì kiểm tra bất kỳ và nếu chuỗi kiểm tra bị chứa bởi chuỗi khác thì chuỗi kiểm tra sẽ bị loại. Tức là hướng tới loại trừ các chuỗi ngắn và có lẽ cũng là tương tự cách tìm chuỗi dài của bạn.

Gửi lại đoạn code đã sửa để kiểm tra

Public Sub Tim_Cau_Hoan_Chinh()
Dim DL, Tam, kq(), r As Long, rw As Long, c As Long

DL = Sheet1.Range("A1").CurrentRegion

For r = 1 To UBound(DL)
For rw = 1 To UBound(DL)
Tam = Split(DL(r, 1), " ")  '<--chuyển vào vòng lặp này
If rw <> r Then
For c = 0 To UBound(Tam)
If InStr(" " & UCase(DL(rw, 1)) & " ", " " & UCase(Tam(c)) & " ") Then  'Thêm chặn chuỗi
Tam(c) = ""
End If
Next c
If Len(Application.Trim(Join(Tam))) = 0 Then DL(r, 1) = ""
End If
Next rw
Next r
ReDim kq(1 To UBound(DL), 1 To 1)

rw = 0
For r = 1 To UBound(DL)
If DL(r, 1) <> "" Then
rw = rw + 1
kq(rw, 1) = DL(r, 1)
End If
Next r
Sheet1.Range("D1", Sheet1.Range("D65000").End(xlUp)).Clear
Sheet1.Range("D1").Resize(rw, 1).Value = kq
End Sub

---
Vẫn chưa xử lý chuỗi rỗng nên dữ liệu lớn chắc là sẽ chậm

[boombut]

-------------
Gửi file đính kèm

Với cùng một dữ liệu, hai code của bạn (bài 8 và bài 12) cho hai kết quả khác nhau. Có lẽ bạn hiệu chỉnh hơi quá tay.