Tìm kiếm - So sánh - Sắp xếp

[Yeuvoyeucon]

Kính gửi Anh Chị,
Em có chuỗi các ký tự từ C8-C13 gồm mặt hàng và ngày kèm theo. Yêu cầu là tìm mặt hàng Dam_Tao, sau đó lấy ra và xếp tại Cột G (Ngày nào lớn hơn xếp trước). Code VBA như thế nào để làm được việc này ạ.

 

[Hoàng Nhật Phương]

Kính gửi Anh Chị,
Em có chuỗi các ký tự từ C8-C13 gồm mặt hàng và ngày kèm theo. Yêu cầu là tìm mặt hàng Dam_Tao, sau đó lấy ra và xếp tại Cột G (Ngày nào lớn hơn xếp trước). Code VBA như thế nào để làm được việc này ạ.

Trong khi chờ đợi giải pháp tối ưu hơn từ mọi người, Bạn thử tạm code này xem ạ:

Option Explicit

Sub chiu_thua()
    Dim du_lieu(), ket_qua()
    Dim sheet As Worksheet, rng As Range, iDate As Date
    Dim chuoi As String, s As String, txt As String
    Dim r As Long, i As Long, k As Long
    
    Set sheet = ThisWorkbook.Worksheets("Sheet1")
    
    chuoi = "Dam_Tao*"
    
    du_lieu = sheet.Range("C8").CurrentRegion.Value2
    r = UBound(du_lieu, 1): ReDim ket_qua(1 To r, 1 To 2)
    For i = 1 To r
        txt = du_lieu(i, 1)
        If txt Like chuoi Then
            k = k + 1
            s = Mid(txt, Len(chuoi) + 1, 10)
            iDate = DateSerial(Right(s, 4), Mid(s, 4, 2), Left(s, 2))
            ket_qua(k, 1) = iDate
            ket_qua(k, 2) = txt
        End If
    Next i
    sheet.Range("G1").Resize(r).ClearContents
    If k = 0 Then Exit Sub
    Set rng = sheet.Range("F1").Resize(k)
    rng.Resize(, 2).Value = ket_qua
    rng.Resize(, 2).Sort key1:=sheet.Range("F1"), order1:=xlDescending, Header:=xlNo
    rng.ClearContents
    
End Sub

 

[ptm0412]

Trong khi chờ đợi giải pháp tối ưu hơn từ mọi người, Bạn thử tạm code này xem ạ:

           chuoi = "Dam_Tao*"
...
         s = Mid(txt, Len(chuoi) + 1, 10)

Sao không phải s = Mid(txt, 9, 10) cho nhanh và dễ hiểu? Tôi đọc code phải dò từng từ và đếm từng ký tự của nào txt, nào chuoi. Nhưng nói chung là có tiến bộ

 

[VetMini]

Bái phục luôn. Làm sao biết được cách tách chuỗi ra "tên hàng" và "ngày" mà cũng code được.

Chú: tránh dùng cái ":" để gộp nhiều dòng lại đi. Nó chỉ làm cho về sau này debug khó hơn thôi.
Ngày xưa người ta bắt buộc phải dùng nó là vì giới hạn của bộ nhớ (giải thích cái này khá dài dòng). Bi giờ việc tiết kiệm bộ nhớ bằng cách gộp dòng cũng như tiết kiệm hạt cát trong sa mạc.

 

[Hoàng Nhật Phương]

Con chào chú Mỹ và bác VetMini ạ,

Sao không phải s = Mid(txt, 9, 10) cho nhanh và dễ hiểu? Tôi đọc code phải dò từng từ và đếm từng ký tự của nào txt, nào chuoi. Nhưng nói chung là có tiến bộ

Chú Mỹ lại kiểm tra con rồi, là vì độ dài chuỗi ký tự có thể không cố định nên con để như vậy ạ, chỉ cần thay đổi chuỗi vào tham số chuỗi đỡ mất công sửa chỗ đó ạ.

Bái phục luôn. Làm sao biết được cách tách chuỗi ra "tên hàng" và "ngày" mà cũng code được.

Chú: tránh dùng cái ":" để gộp nhiều dòng lại đi. Nó chỉ làm cho về sau này debug khó hơn thôi.
Ngày xưa người ta bắt buộc phải dùng nó là vì giới hạn của bộ nhớ (giải thích cái này khá dài dòng). Bi giờ việc tiết kiệm bộ nhớ bằng cách gộp dòng cũng như tiết kiệm hạt cát trong sa mạc.

Dạ con chỉ làm theo dữ liệu minh họa đó thôi Bác, có thể với dữ liệu thực độ dài không có tiêu chuẩn thì đúng là con chịu luôn ạ.

 

[befaint]

chuoi = "Dam_Tao*"

'
Const chuoiXYZ = "Dao_Tao*"
Dim numChar as Long
numChar = len(chuoiXYZ)
'...
For i = 1 To r
'...
s = Mid(txt, numChar + 1, 10)

 

[Yeuvoyeucon]

Trong khi chờ đợi giải pháp tối ưu hơn từ mọi người, Bạn thử tạm code này xem ạ:

Option Explicit

Sub chiu_thua()
    Dim du_lieu(), ket_qua()
    Dim sheet As Worksheet, rng As Range, iDate As Date
    Dim chuoi As String, s As String, txt As String
    Dim r As Long, i As Long, k As Long
   
    Set sheet = ThisWorkbook.Worksheets("Sheet1")
   
    chuoi = "Dam_Tao*"
   
    du_lieu = sheet.Range("C8").CurrentRegion.Value2
    r = UBound(du_lieu, 1): ReDim ket_qua(1 To r, 1 To 2)
    For i = 1 To r
        txt = du_lieu(i, 1)
        If txt Like chuoi Then
            k = k + 1
            s = Mid(txt, Len(chuoi) + 1, 10)
            iDate = DateSerial(Right(s, 4), Mid(s, 4, 2), Left(s, 2))
            ket_qua(k, 1) = iDate
            ket_qua(k, 2) = txt
        End If
    Next i
    sheet.Range("G1").Resize(r).ClearContents
    If k = 0 Then Exit Sub
    Set rng = sheet.Range("F1").Resize(k)
    rng.Resize(, 2).Value = ket_qua
    rng.Resize(, 2).Sort key1:=sheet.Range("F1"), order1:=xlDescending, Header:=xlNo
    rng.ClearContents
   
End Sub

Cảm ơn sự giúp đỡ nhiệt tình của Bạn và các ANh chị trong diễn đàn !!!

 

[ptm0412]

Chú Mỹ lại kiểm tra con rồi, là vì độ dài chuỗi ký tự có thể không cố định nên con để như vậy ạ, chỉ cần thay đổi chuỗi vào tham số chuỗi đỡ mất công sửa chỗ đó ạ.

Dù gì thì nên dùng biến khác, chứ biến đó đang có dấu * nhằm mục đích tìm kiếm chứ không phải độ dài mã. Nên dùng biến nào ra biến đó