Cần giúp VBA so sánh 2 chuỗi ký tự có điều kiện

PeterVu

Yêu THVBA nhất
Chào các bạn,

Xin được giúp VBA để so sánh 2 chuỗi ký tự với điều kiện từng dòng như dưới đây.


NoLocation 1Location 2Yêu cầu "So sánh và đưa ra kết quả 2 cột bằng hoặc khác nhau"Kết quả
1STUFF REF DES: D58-D72D58,D59,D60,D61,D62,D63,D64,D65,D66,D67,D68,D69,D70,D71,D72Giải thích các bước so sánh:
1.) So sánh vị trí phía sau "STUFF REF DES: " của Location 1, với Location 2.
2.) Ở cột Location 1: "D58-D72" vba sẽ hiểu nghĩa là vị trí từ vị trí D58 đến D72, phân biệt giữa vị trị trước và sau bằng dấu " , " như Location 2.
=> Kết qua so sánh ở dòng này của 2 cột sẽ bằng nhau
Match
2STUFF REF DES: C167-C172C167,C168,C169,C170,C171Giải thích các bước so sánh:
1.) So sánh vị trí phía sau "STUFF REF DES: " của Location 1, với Location 2.
2.) Ở cột Location 1: "C167-C172" vba sẽ hiểu nghĩa là từ vị trí C167 đến C172, phân biệt giữa vị trị trước và sau bằng dấu " , " như Location 2.
=> Kết qua so sánh ở dòng này của 2 cột sẽ khác nhau vì cột Location 2, thiếu vị trí C172
Not match
3STUFF REF DES: E13, E14, E15E13,E14,E15Giải thích các bước so sánh:
1.) So sánh vị trí phía sau "STUFF REF DES: " của Location 1, với Location 2.
2.) Ở cột Location 1: có dấu cách giữa các vị trí, cột Location 2 thì không có dấu cách
=> Kết qua so sánh ở dòng này của 2 cột này sẽ bằng nhau (bỏ qua dấu cách giữa các vị trí khi so sánh)
Match
 
B

bvtvba

Guest
Dựa vào data bạn đưa ra thì giải như sau:
Download file:

Mã:
Sub sosanh()
    Dim i   As Long
    Dim rend    As Long
    Dim kt1 As String, kt2 As String
    Dim arr As Variant, brr As Variant 'arr: du lieu cot B, brr: du lieu cot C
    Dim crr As Variant 'ket qua so sanh
    Const rstart As Long = 2 'Dong bat dau chua du lieu
    rend = Cells(Rows.Count, 1).End(xlUp).Row 'Xac dinh dong cuoi cung tren cot A
    If rend < 2 Then
        MsgBox "Khong chua du lieu"
    End If
    arr = Range(Cells(rstart, 2), Cells(rend, 2)).Value 'Lay du lieu cot B
    brr = Range(Cells(rstart, 3), Cells(rend, 3)).Value 'Lay du lieu cot C
    ReDim crr(1 To rend - 1)
    For i = LBound(arr, 1) To UBound(arr, 1) Step 1
        kt1 = chuyendoi(CStr(arr(i, 1)))
        kt2 = chuyendoi(CStr(brr(i, 1)))
        crr(i) = kiemtra(kt1, kt2)
    Next i
    'Ghi ket qua :
    For i = rstart To rend Step 1
        Cells(i, 5).Value = crr(i - 1) 'Ghi ket qua len cot E
    Next i
    
End Sub
'INPUT:
's1: C167,C168,C169,C170,C171, C172
's2: C167,C168,C169,C170,C171
'OUTPUT: Not Match
Function kiemtra(ByVal s1 As String, ByVal s2 As String) As String
    Dim arr As Variant, brr As Variant
    Dim i As Long, j As Long
    kiemtra = "Match" 'Ket qua mac dinh la OK
    If Len(s1) <> Len(s2) Then
        kiemtra = "Not Match"
        Exit Function
          
    End If
    
    arr = Split(s1, ",")
    brr = Split(s2, ",")
    
    For i = LBound(arr) To UBound(arr) Step 1
        If InStr(1, s2, CStr(arr(i))) = 0 Then
            kiemtra = "Not Match"
            Exit Function
        End If
    Next i
    
    For i = LBound(brr) To UBound(brr) Step 1
        If InStr(1, s1, CStr(brr(i))) = 0 Then
            kiemtra = "Not Match"
            Exit Function
        End If
    Next i
    
End Function
'INPUT: STUFF REF DES: D58-D72
'OUTPUT: D58,D59,D60,D61,D62,D63,D64,D65,D66,D67,D68,D69,D70,D71,D72

'INPUT:STUFF REF DES: E13, E14, E15
'OUTPUT: E13,E14,E15
Function chuyendoi(ByVal s1 As String) As String
    Dim c1  As String
    Dim drr As Variant
    Dim ketqua  As String
    Dim temp    As String, temp2 As String, temp3 As String
    
    Dim i       As Long, j As Long
    Dim vt      As Long
    Dim ktd     As String 'ky tu dau. Vi du: E13 thi la E. C167 thi la C
    Dim so1     As String, so2 As String
    
    Const s As String = "STUFF REF DES:"
    c1 = Replace(s1, "STUFF REF DES:", "")
    drr = Split(c1, ",")
    For i = LBound(drr) To UBound(drr) Step 1
        temp = Trim(CStr(drr(i)))
        vt = InStr(1, temp, "-")
        If vt = 0 Then 'Ex: E12
            ketqua = ketqua & temp & ","
        Else
            'Ex: C167-C172
            If vt > 1 Then
                temp2 = Left(temp, vt - 1)
                temp3 = Right(temp, Len(temp) - vt)
                temp2 = Trim(temp2)
                temp3 = Trim(temp3)
                ktd = Left(temp2, 1) 'C167 => C
                so1 = Right(temp2, Len(temp2) - 1) 'C167: 167
                so2 = Right(temp3, Len(temp3) - 1) 'C171: 171
                If IsNumeric(so1) = True And IsNumeric(so2) Then
                    If Val(so1) < Val(so2) Then
                        For j = Val(so1) To Val(so2) Step 1
                            ketqua = ketqua & ktd & j & "," ' & C167
                        Next j
                    End If
                End If
                
                
            End If
        End If
    Next i
    chuyendoi = Left(ketqua, Len(ketqua) - 1)
End Function
 
T

thanhphong

Guest
Code khá thông minh, thử cố tình tạo ra dòng dữ liệu như ở dòng 2, code vẫn phát hiện là Match.
Bạn cần đăng nhập để thấy hình ảnh

So với yêu cầu ban đầu #1 thì code ở #2 đã đáp ứng yêu cầu nên mình không code nữa.
 

PeterVu

Yêu THVBA nhất
Dựa vào data bạn đưa ra thì giải như sau:
Download file:

Mã:
Sub sosanh()
    Dim i   As Long
    Dim rend    As Long
    Dim kt1 As String, kt2 As String
    Dim arr As Variant, brr As Variant 'arr: du lieu cot B, brr: du lieu cot C
    Dim crr As Variant 'ket qua so sanh
    Const rstart As Long = 2 'Dong bat dau chua du lieu
    rend = Cells(Rows.Count, 1).End(xlUp).Row 'Xac dinh dong cuoi cung tren cot A
    If rend < 2 Then
        MsgBox "Khong chua du lieu"
    End If
    arr = Range(Cells(rstart, 2), Cells(rend, 2)).Value 'Lay du lieu cot B
    brr = Range(Cells(rstart, 3), Cells(rend, 3)).Value 'Lay du lieu cot C
    ReDim crr(1 To rend - 1)
    For i = LBound(arr, 1) To UBound(arr, 1) Step 1
        kt1 = chuyendoi(CStr(arr(i, 1)))
        kt2 = chuyendoi(CStr(brr(i, 1)))
        crr(i) = kiemtra(kt1, kt2)
    Next i
    'Ghi ket qua :
    For i = rstart To rend Step 1
        Cells(i, 5).Value = crr(i - 1) 'Ghi ket qua len cot E
    Next i
   
End Sub
'INPUT:
's1: C167,C168,C169,C170,C171, C172
's2: C167,C168,C169,C170,C171
'OUTPUT: Not Match
Function kiemtra(ByVal s1 As String, ByVal s2 As String) As String
    Dim arr As Variant, brr As Variant
    Dim i As Long, j As Long
    kiemtra = "Match" 'Ket qua mac dinh la OK
    If Len(s1) <> Len(s2) Then
        kiemtra = "Not Match"
        Exit Function
         
    End If
   
    arr = Split(s1, ",")
    brr = Split(s2, ",")
   
    For i = LBound(arr) To UBound(arr) Step 1
        If InStr(1, s2, CStr(arr(i))) = 0 Then
            kiemtra = "Not Match"
            Exit Function
        End If
    Next i
   
    For i = LBound(brr) To UBound(brr) Step 1
        If InStr(1, s1, CStr(brr(i))) = 0 Then
            kiemtra = "Not Match"
            Exit Function
        End If
    Next i
   
End Function
'INPUT: STUFF REF DES: D58-D72
'OUTPUT: D58,D59,D60,D61,D62,D63,D64,D65,D66,D67,D68,D69,D70,D71,D72

'INPUT:STUFF REF DES: E13, E14, E15
'OUTPUT: E13,E14,E15
Function chuyendoi(ByVal s1 As String) As String
    Dim c1  As String
    Dim drr As Variant
    Dim ketqua  As String
    Dim temp    As String, temp2 As String, temp3 As String
   
    Dim i       As Long, j As Long
    Dim vt      As Long
    Dim ktd     As String 'ky tu dau. Vi du: E13 thi la E. C167 thi la C
    Dim so1     As String, so2 As String
   
    Const s As String = "STUFF REF DES:"
    c1 = Replace(s1, "STUFF REF DES:", "")
    drr = Split(c1, ",")
    For i = LBound(drr) To UBound(drr) Step 1
        temp = Trim(CStr(drr(i)))
        vt = InStr(1, temp, "-")
        If vt = 0 Then 'Ex: E12
            ketqua = ketqua & temp & ","
        Else
            'Ex: C167-C172
            If vt > 1 Then
                temp2 = Left(temp, vt - 1)
                temp3 = Right(temp, Len(temp) - vt)
                temp2 = Trim(temp2)
                temp3 = Trim(temp3)
                ktd = Left(temp2, 1) 'C167 => C
                so1 = Right(temp2, Len(temp2) - 1) 'C167: 167
                so2 = Right(temp3, Len(temp3) - 1) 'C171: 171
                If IsNumeric(so1) = True And IsNumeric(so2) Then
                    If Val(so1) < Val(so2) Then
                        For j = Val(so1) To Val(so2) Step 1
                            ketqua = ketqua & ktd & j & "," ' & C167
                        Next j
                    End If
                End If
               
               
            End If
        End If
    Next i
    chuyendoi = Left(ketqua, Len(ketqua) - 1)
End Function
Xin chân thành cám ơn sự giúp đỡ của bạn. Logic về Input và Output rất rõ ràng, cách coding và chú thích dễ hiểu, tôi nhìn thấy điểm tương đồng về cách coding giữa bạn và thanhphong
 

PeterVu

Yêu THVBA nhất
Code khá thông minh, thử cố tình tạo ra dòng dữ liệu như ở dòng 2, code vẫn phát hiện là Match.
Bạn cần đăng nhập để thấy hình ảnh

So với yêu cầu ban đầu #1 thì code ở #2 đã đáp ứng yêu cầu nên mình không code nữa.
Cám ơn bạn đã quan tâm. Về ví dụ bạn tạo thêm dữ liệu ở dòng 2 để code phát hiện chính là ví dụ mà mình thiếu xót khi đưa ra dữ liệu ban đầu. Nhưng code bạn bvtvba viết đã giải quyết được vấn đề này. Lại 1 lần nữa có được kết quả ngoài mong đợi.
Tôi đang triển khai 1 dự án về chi tiết khá phức tạp, nên nếu bạn hoặc bvtvba có thể cho số điện thoại liên lạc, hoặc nếu tiện gặp trực tiếp ở Hà nội để tôi có thể trình bầy cụ thể được thì tốt, viết ra đây sợ không hết ý hoặc thiếu xót.
Nếu dự án đạt được kết quả như mong đợi chắc chắn tôi sẽ ủng hộ diễn đàn và các bạn 1 khoản (ko nhỏ) trong khả năng của mình. Mong sớm được liên hệ để triển khai dự án.
 
B

bvtvba

Guest
Cảm ơn bạn đã phản hồi về kết quả chạy thử, mình rất vui khi biết chương trình đã đáp ứng yêu cầu của bạn.
Ở đoạn này nên thêm câu lệnh thoát chương trình thì hay hơn:
Mã:
If rend < 2 Then
        MsgBox "Khong chua du lieu"
        Exit Sub
End If
Mình chỉ code những chương trình nhỏ thôi, còn cả dự án kết hợp nhiều đoạn chương trình với nhau thì vẫn đang học hỏi mọi người trên diễn đàn, từ cách tổ chức chương trình, tới việc comment cho dễ hiểu, đặt tên biến như nào để mọi người cùng hiểu. Vì vậy, đáp ứng kỳ vọng tham gia dự án của bạn thì bạn thử nhờ tới đội ngũ Admin của diễn đàn.
 

vbano1

SMod
Thành viên BQT
1. Nếu khai báo crr là mảng hai chiều thì sẽ không cần đoạn code này để ghi kết quả:
Mã:
For i = rstart To rend Step 1
        Cells(i, 5).Value = crr(i - 1) 'Ghi ket qua len cot E
Next i
Thay vào đó chúng ta dùng phép gán trực tiếp, như vậy thì đỡ nhọc hơn.
2. Chương trình đã đáp ứng yêu cầu với điều kiện Input đầu vào mặc định theo đúng chuẩn mà tác giả đưa ra. Trong trường hợp cách ghi dữ liệu có nhầm lẫn, không đúng theo chuẩn mà tác giả đưa ra, thì chương trình chưa có đoạn code để báo định dạng dữ liệu sai.
Thật ra việc này cũng khó và phức tạp, phải là người hiểu rõ định dạng dữ liệu có những trường hợp như thế nào thì mới code kiểm tra dữ liệu đầu vào có chính xác hay không, tuy nhiên code #2 cũng đã vượt được kỳ vọng ban đầu trong trường hợp dữ liệu đầu vào có sự tùy biến như bài viết #3 đã nêu.

Theo thông tin từ chủ topic, bạn ấy đang có một dự án và cần người tham gia hỗ trợ code, kèm theo lời hứa ủng hộ diễn đàn. Đây là thông tin bổ ích vì diễn đần thật ra cũng cần tiền để duy trì hoạt động thay vì cứ bỏ tiền túi từ một vài thành viên quản trị tâm huyết như hiện nay. Vì vậy BQT diễn đàn sẽ sớm liên hệ và cộng tác cùng bạn.
 

PeterVu

Yêu THVBA nhất
Cảm ơn bạn đã phản hồi về kết quả chạy thử, mình rất vui khi biết chương trình đã đáp ứng yêu cầu của bạn.
Ở đoạn này nên thêm câu lệnh thoát chương trình thì hay hơn:
Mã:
If rend < 2 Then
        MsgBox "Khong chua du lieu"
        Exit Sub
End If
Mình chỉ code những chương trình nhỏ thôi, còn cả dự án kết hợp nhiều đoạn chương trình với nhau thì vẫn đang học hỏi mọi người trên diễn đàn, từ cách tổ chức chương trình, tới việc comment cho dễ hiểu, đặt tên biến như nào để mọi người cùng hiểu. Vì vậy, đáp ứng kỳ vọng tham gia dự án của bạn thì bạn thử nhờ tới đội ngũ Admin của diễn đàn.
Cám ơn bạn, mong sẽ nhận được sự giúp đỡ trên những chương trình nhỏ.
 

PeterVu

Yêu THVBA nhất
1. Nếu khai báo crr là mảng hai chiều thì sẽ không cần đoạn code này để ghi kết quả:
Mã:
For i = rstart To rend Step 1
        Cells(i, 5).Value = crr(i - 1) 'Ghi ket qua len cot E
Next i
Thay vào đó chúng ta dùng phép gán trực tiếp, như vậy thì đỡ nhọc hơn.
2. Chương trình đã đáp ứng yêu cầu với điều kiện Input đầu vào mặc định theo đúng chuẩn mà tác giả đưa ra. Trong trường hợp cách ghi dữ liệu có nhầm lẫn, không đúng theo chuẩn mà tác giả đưa ra, thì chương trình chưa có đoạn code để báo định dạng dữ liệu sai.
Thật ra việc này cũng khó và phức tạp, phải là người hiểu rõ định dạng dữ liệu có những trường hợp như thế nào thì mới code kiểm tra dữ liệu đầu vào có chính xác hay không, tuy nhiên code #2 cũng đã vượt được kỳ vọng ban đầu trong trường hợp dữ liệu đầu vào có sự tùy biến như bài viết #3 đã nêu.

Theo thông tin từ chủ topic, bạn ấy đang có một dự án và cần người tham gia hỗ trợ code, kèm theo lời hứa ủng hộ diễn đàn. Đây là thông tin bổ ích vì diễn đần thật ra cũng cần tiền để duy trì hoạt động thay vì cứ bỏ tiền túi từ một vài thành viên quản trị tâm huyết như hiện nay. Vì vậy BQT diễn đàn sẽ sớm liên hệ và cộng tác cùng bạn.
Cám ơn đội ngũ Admin, hy vọng hợp tác tốt đẹp
 
Top