Tìm các chuỗi số gần gống trong vba? (1 người xem)

[echipsun]

0942113305
0942118766
0942114183
0943217967
0942118148
0942118266
0947415495
0943917967
0942154437
0942192157

Mình có chuỗi số như trên, mình muốn tìm các cặp chuỗi số gần giống nhau vd: cặp 0942118766 & 0942118266, 0943917967 & 0943217967, mình phải làm sao?

 

[siwtom]

0942113305
0942118766
0942114183
0943217967
0942118148
0942118266
0947415495
0943917967
0942154437
0942192157

Mình có chuỗi số như trên, mình muốn tìm các cặp chuỗi số gần giống nhau vd: cặp 0942118766 & 0942118266, 0943917967 & 0943217967, mình phải làm sao?

Bạn nên rút kinh nghiệm. Ví dụ chỉ là bổ sung cho miêu tả chứ không bao giờ được thay cho miêu tả. Bạn có cho 10 ví dụ thì chưa chắc đã lường được mọi trường hợp. Và nếu chỉ ví dụ thôi thì người khác luôn phải phân tích ví dụ để rút ra qui luật. Nhiều khi việc đoán ý và rút ra kết luận rất khó. Bạn nhờ người ta thì bạn nên giảm tới mức tối đa thời gian mà người ta sẽ bỏ ra để giúp bạn.

Tôi đoán ý bạn và miêu tả như sau. Nếu không đúng ý thì tôi cũng kết thúc ở đây. Lần sau bạn nên bắt chước miêu tả như thế.

Cũng cần nói thêm là nếu trong nhà trường chưa có chỗ nào (Toán học) phát biểu khái niệm cặp số "gần giống nhau" thì đó là khái niệm riêng của bạn. Vì thế bạn phải phát biểu khái niệm đó.

1. Khái niệm: Hai số "gần giống nhau" là hai số có cùng số chữ số và khác nhau nhiều nhất một chữ số ở cùng vị trí.
2. Yêu cầu. Hãy tìm trong các số cho trước những cặp số "gần giống nhau"
--------------
code ví dụ

Function tachnhom(ByVal rng)
Dim Arr, result(), tmp(), count As Long, index As Long, r As Long, a As Long, b As Long, diff As Long
    Arr = rng.Value
    
    ReDim result(1 To 2, 1 To 1)
    For index = 1 To UBound(Arr, 1) - 1
        a = Arr(index, 1)
        If a > 0 Then
            For r = index + 1 To UBound(Arr, 1)
                b = Arr(r, 1)
                If b > 0 And Len(CStr(a)) = Len(CStr(b)) Then
                    diff = Abs(b - a)
                    If diff < 10 Or Mid(diff, 2, Len(CStr(diff))) = 0 Then
                        count = count + 1
                        ReDim Preserve result(1 To 2, 1 To count)
                        result(1, count) = a
                        result(2, count) = b
                    End If
                End If
            Next
        End If
    Next
    ReDim tmp(1 To UBound(result, 2), 1 To 2)
    For r = 1 To UBound(result, 2)
        For index = 1 To 2
            tmp(r, index) = result(index, r)
        Next
    Next
    tachnhom = tmp
End Function

Sub test()
Dim Arr
    Range("B:C").ClearContents
    Arr = tachnhom(Range("A1:A10"))
    Range("B1").Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
End Sub

Tôi chỉ test 1 lần với dữ liệu giả lập của bạn. Hi vọng đúng. Nếu chưa chuẩn ta tính tiếp

 

[concogia]

0942113305
0942118766
0942114183
0943217967
0942118148
0942118266
0947415495
0943917967
0942154437
0942192157

Mình có chuỗi số như trên, mình muốn tìm các cặp chuỗi số gần giống nhau vd: cặp 0942118766 & 0942118266, 0943917967 & 0943217967, mình phải làm sao?

Hihi, chơi đoán đề bài cũng là một hình thức rèn luyện .........kiên nhẫn
Tham gia một code:

Public Sub GanGiong()
    Dim Vung, I, J, K, Kq, Dk
    Vung = Range([A4], [A50000].End(xlUp))
    ReDim Kq(1 To UBound(Vung), 1 To 1)
        For I = 1 To UBound(Vung)
            For J = I + 1 To UBound(Vung)
                Dk = VBA.Abs(Val(Vung(I, 1)) - Val(Vung(J, 1)))
                If Dk < 10 Or Right(Dk, Len(Dk) - 1) = 0 Then
                    K = K + 1
                    Kq(K, 1) = Vung(I, 1) & " - " & Vung(J, 1)
                End If
            Next J
        Next I
    [C4:C5000].ClearContents
    [C4].Resize(K) = Kq
End Sub

Thân