So sánh 5 chuỗi cùng lúc? (2 người xem)

[emgaingayngo]

Em có 5 chuỗi như sau:

strChucNganC = "968709290665" (chuỗi 1)
strNganC = "5297499041003620" (chuỗi 2)
strTramC = "72905335809204842" (chuỗi 3)
strDvC = "150621943994125633" (chuỗi 4)
strChucC = "843999994716719825" (chuỗi 5)

Lần lượt lấy mỗi lần 3 ký tự liên tiếp trong 1 chuỗi, đem so sánh với 4 chuỗi còn lại, nếu giống nhau thì lấy ra.

Em đã xử lý như sau,

Sub SoDocChinh()
Dim i As Long, j As Long
Dim chChucNgan As String, chNgan As String, KQ As String
Dim chTram As String, chChuc As String, chDv As String
Dim chChucNgan1 As String, chNgan1 As String, chTram1 As String, chChuc1 As String, chDv1 As String
 
strChucNganC = "968709290665"
strNganC = "5297499041003620"
strTramC = "72905335809204842"
strDvC = "150621943994125633"
strChucC = "843999994716719825"
 
Columns(3).ClearContents
'LayChuoi
 
'Hang ChucNgan so sanh voi Ngan
For i = 1 To 10
KQ = ""
 chChucNgan = DAO3SO(Mid(strChucNganC, i, 3))
    For j = 1 To 14
    chNgan = DAO3SO(Mid(strNganC, j, 3))
    If chChucNgan = chNgan Then
    KQ = Trim(chNgan)
    End If
    Next j
 Range("C1000").End(xlUp).Offset(1, 0).Value = KQ
Next i
 
'Hang ChucNgan so sanh voi Tram
For i = 1 To 10
KQ = ""
 chChucNgan = DAO3SO(Mid(strChucNganC, i, 3))
    For j = 1 To 15
    chTram = DAO3SO(Mid(strTramC, j, 3))
        If chChucNgan = chTram Then
            KQ = Trim(chTram)
        End If
    Next j
 Range("C1000").End(xlUp).Offset(1, 0).Value = KQ
Next i
 
'Hang ChucNgan so sanh voi Chuc
For i = 1 To 10
KQ = ""
 chChucNgan = DAO3SO(Mid(strChucNganC, i, 3))
    For j = 1 To 16
    chChuc = DAO3SO(Mid(strChucC, j, 3))
        If chChucNgan = chChuc Then
            KQ = Trim(chChuc)
        End If
    Next j
 Range("C1000").End(xlUp).Offset(1, 0).Value = KQ
Next i
.....................
.......................

nhưng dài quá, khó nâng cấp.

Em sử dụng 4 For...nhưng chẳng bit ghi KQ như thế nào để nó khỏi ghi lặp lại KQ đã ghi.

Sub QuetAll()
Dim m As Long, n As Long, p As Long, q As Long, r As Long
Dim chChucNgan As String, chNgan As String, KQ1 As String
Dim chTram As String, chChuc As String, chDv As String
Columns(3).ClearContents
strChucNganC = "968709290665"
strNganC = "5297499041003620"
strTramC = "72905335809204842"
strDvC = "150621943994125633"
strChucC = "843999994716719825"
'LayChuoi
For m = 1 To 10
chChucNgan = DAO3SO(Mid(strChucNganC, m, 3))
    For n = 1 To 14
    chNgan = DAO3SO(Mid(strNganC, n, 3))
        For p = 1 To 15
        chTram = DAO3SO(Mid(strTramC, p, 3))
            For q = 1 To 16
            chChuc = DAO3SO(Mid(strChucC, q, 3))
                For r = 1 To 16
                chDv = DAO3SO(Mid(strDvC, r, 3))
 
 
 
                Next r
            'Range("C10000").End(xlUp).Offset(1, 0).Value = KQ1
            Next q
        'Range("C10000").End(xlUp).Offset(1, 0).Value = KQ1
        Next p
    'Range("C10000").End(xlUp).Offset(1, 0).Value = KQ1
    Next n
Range("C10000").End(xlUp).Offset(1, 0).Value = KQ1
Next m
End Sub

Ai có cách nào ngắn gọn giúp mình giải quyết với! Thanks!

 

[ChanhTQ@]

Bạn nhập 5 số trị đó vô A1:A5 dạng chuỗi (Thêm dấu nháy vào đầu các ký số)

& chạy macro sau:

Option Explicit
Sub Tim3ChuTrongChuoi()
 Dim jJ As Byte, Ww As Byte, DDai As Byte
 Dim StrC As String:                    Dim sRng As Range, Rng As Range
 
 For jJ = 1 To 5
   StrC = Cells(jJ, "A").Value
   Select Case jJ
   Case 1
      Set Rng = Union([A2], [A3], [A4], [A5])
   Case 2
      Set Rng = Union([A1], [A3], [A4], [A5])
   Case 3
      Set Rng = Union([A1], [A2], [A4], [A5])
   Case 4
      Set Rng = Union([A1], [A2], [A3], [A5])
   Case 5
      Set Rng = Union([A1], [A2], [A3], [A4])
   End Select
   DDai = Len(StrC)
   For Ww = 1 To DDai - 2
      Set sRng = Rng.Find(Mid(StrC, Ww, 3), , xlFormulas, xlPart)
      If Not sRng Is Nothing Then
         With Cells(65500, jJ + 1).End(xlUp).Offset(1)
            .Value = Mid(StrC, Ww, 3) & "-" & jJ
         End With
      End If
   Next Ww
 Next jJ
End Sub

 

[minhtu]

Em có 5 chuỗi như sau:

strChucNganC = "968709290665" (chuỗi 1)
strNganC = "5297499041003620" (chuỗi 2)
strTramC = "72905335809204842" (chuỗi 3)
strDvC = "150621943994125633" (chuỗi 4)
strChucC = "843999994716719825" (chuỗi 5)

...

Code ban đầu của bạn ngắn gọn, dễ hiểu, dễ nâng cấp rồi đấy chứ. Mình chỉ tách chút xíu và cắt bớt phần thừa giúp bạn thôi, còn thuật toán vẫn là của bạn.

Sub Sosanh2Chuoi(ByVal st1$, ByVal st2$)
    Dim i%, j%, tmp1$, tmp2$, KQ$
    
    For i = 1 To Len(st1) - 2
        tmp1 = DAO3SO(Mid(st1, i, 3))
        
        KQ = ""
        For j = 1 To Len(st2) - 2
            tmp2 = DAO3SO(Mid(st2, j, 3))
            
            If tmp1 = tmp2 Then KQ = Trim(tmp1)
        Next j
        
        Range("D1000").End(xlUp).Offset(1, 0).Value = KQ
    Next i
End Sub
Sub SosanhChinhno(ByVal st$)
    Dim i%, j%, tmp1$, tmp2$, KQ$
    
    For i = 1 To Len(st) - 2
        tmp1 = DAO3SO(Mid(st, i, 3))
        
        KQ = ""
        For j = i + 1 To Len(st) - 2
            tmp2 = DAO3SO(Mid(st, j, 3))
            
            If tmp1 = tmp2 Then KQ = Trim(tmp1)
        Next j
        
        Range("D1000").End(xlUp).Offset(1, 0).Value = KQ
    Next i
End Sub
Sub SoDocChinh2()
    Dim i As Long, j As Long
    Dim strChucNganC$, strNganC$, strTramC$, strChucC$, strDvC$
    
    strChucNganC = "968709290665"
    strNganC = "5297499041003620"
    strTramC = "72905335809204842"
    strChucC = "843999994716719825"
    strDvC = "150621943994125633"
    
    Columns(4).ClearContents
    
    'Hang ChucNgan
    Call Sosanh2Chuoi(strChucNganC, strNganC)
    Call Sosanh2Chuoi(strChucNganC, strTramC)
    Call Sosanh2Chuoi(strChucNganC, strChucC)
    Call Sosanh2Chuoi(strChucNganC, strDvC)
    
    'Hang Ngan
    Call Sosanh2Chuoi(strNganC, strTramC)
    Call Sosanh2Chuoi(strNganC, strChucC)
    Call Sosanh2Chuoi(strNganC, strDvC)
    
    'Hang Tram
    Call Sosanh2Chuoi(strTramC, strChucC)
    Call Sosanh2Chuoi(strTramC, strDvC)
    
    'Hang Chuc
    Call Sosanh2Chuoi(strChucC, strDvC)
    
    'So sanh voi chinh no
    Call SosanhChinhno(strChucNganC)
    Call SosanhChinhno(strNganC)
    Call SosanhChinhno(strTramC)
    Call SosanhChinhno(strChucC)
    Call SosanhChinhno(strDvC)
End Sub