Tìm kiếm chuỗi ký tự gần giống nhau.

[xuanthanh295]

Xin chào cả nhà.

Mình hiện đang làm nhận làm lại kế toán cho một công ty. Tuy nhiên có một vấn đề mà mình chưa giải quyết được mong các bạn giúp đỡ.

Trước đây bên nội bộ theo dõi mã hàng riêng và tên hàng riêng, bên thuế cũng theo dõi riêng. Tên mặt hàng gần giống nhau, chỉ khác nhau một chút ít.
Ví dụ: bên nội bộ theo dõi: Mã 210236 - Bánh Rosy kem hương chanh 100g. Còn bên thuế theo dõi: Mã HH-002 - Bánh Rosy kem hương chanh 100g 24/thg. ( Mọi người xem file đính kèm)

Tuy nhiên bây giờ công ty muốn thống nhất theo dõi một bộ mã, chuyển toàn bộ mã thuế về hết mã nội bộ cho việc theo dõi bán hàng qua mã vạch. Nhưng mình không thể tìm được tên giống nhau để chuyển, bởi vì số lượng mã hơn 3000 mã và đều có số dư.

Các bạn xem có công thức nào gần đúng để tìm tên mặt hàng này tương ứng với mã nào nội bộ không? Xin giúp mình.

Cảm ơn mọi người.

 

[jack nt]

Option Explicit
Const FIRST_ROW = 3, LAST_ROW = 21


Private Sub CommandButton1_Click()
    Dim i&, a$(), Str$
    For i = FIRST_ROW To LAST_ROW
        a = Split(Cells(i, 6))
        ReDim Preserve a(3)
        Str = convertMH(a())
        If InStr(Str, "|") = 0 Then
            Cells(i, 8) = Str    'nếu tìm thấy thì ghi luôn vào cột 8.
        Else
            Cells(i, 9) = Str    'còn không thì ghi các mã khả dĩ vào cột 9.
        End If
    Next
End Sub


Private Function convertMH$(a$())
    Dim i&, Str$
    Str = searchMH(a(0) & " " & a(1) & " " & a(2) & " " & a(3)) 'tìm với 4 từ đầu tiên
    If Str = vbNullString Then                                  'nếu không tìm thấy
    Str = searchMH(a(0) & " " & a(1) & " " & a(2))              'thì tìm với 3 từ đầu tiên
    End If
    If Str = vbNullString Then                                  'nếu không tìm thấy
        Str = searchMH(a(0) & " " & a(1))                       'thì tìm với 2 từ đầu tiên
    End If
    If Str = vbNullString Then                                  'nếu không tìm thấy
        Str = searchMH(a(0))                                    'thì tìm với 1 từ đầu tiên
    End If
    convertMH$ = Str
End Function


Private Function searchMH$(StrSearch$)
    Dim Str$, i&
    Str = vbNullString
    For i = FIRST_ROW To LAST_ROW
        If InStr(1, Cells(i, 2), StrSearch, vbTextCompare) > 0 Then
            Str = Str & "|" & Trim(Cells(i, 1))
        End If
    Next
    If Str <> vbNullString Then
        searchMH$ = Right(Str, Len(Str) - 1)
    End If
End Function

tui đã làm thử chỉ không đổi được
mã HH-015: sai chính tả: Milo 3in1 SICh MP 20(3(10x15g) VN. các mã khả dĩ là: 220151|220148|220161|220165
mã HH-003: Sôcôla Lindt Lindor Assorted 168g là 210215 Sosola Lindt Lindor Assorted 168g (Sôcôla khác với Socola)
mã HH-011: sai chính tả đạu ngự Castello 400g (24H/T) (đúng là đậu ngự - mã 220100)

p/s: nhớ đổi first_row và last_row cho phù hợp với file thực của dạn

 

[xuanthanh295]

cảm ơn bác jack. em thử tìm luôn bây giờ

 

[jack nt]

nếu các mã là quá nhiều, để dễ phát hiện các mã khả dĩ có thể tô màu các ô có mã khả dĩ bẳng thủ tục

Private Sub colorMH(StrColor$)
    Dim a$(), i&, j&
    a = Split(StrColor, "|")
    For i = FIRST_ROW To LAST_ROW
        For j = 0 To UBound(a)
            If Cells(i, 1) = a(j) Then
                Cells(i, 1).Resize(1, 3).Interior.Color = vbYellow
                Exit For
            End If
        Next
    Next
End Sub

và thêm 1 dòng code

[B][COLOR=#0000ff]colorMH Str[/COLOR][/B]

vào thủ tục

Private Sub CommandButton1_Click()
    Dim i&, a$(), Str$
    For i = FIRST_ROW To LAST_ROW
        a = Split(Cells(i, 6))
        ReDim Preserve a(3)
        Str = convertMH(a())
        If InStr(Str, "|") = 0 Then
            Cells(i, 8) = Str    'n?u tìm th?y thì ghi luôn vào c?t 8.
        Else
            Cells(i, 9) = Str    'còn không thì ghi các mã kh? di vào c?t 9.
[B][COLOR=#0000ff]            colorMH Str[/COLOR][/B]
        End If
    Next
End Sub