Bài toán tìm 4 con số cuối trong dãy ký tự bị mix với nhau. (1 người xem)

khoa140383 · 23/12/15

Chúc cả nhà một ngày làm việc vui vẻ !!!
Hiện em đang gặp một bài toán cũng hơi khó với trình độ của em nên em post lên mong cả nhà giúp đỡ ( mặc dù đã tìm kiếm nát google nhưng chưa ra ).
Chẳng là dạo này khi xuất hàng các bạn thủ kho hay bị nhầm lẫn với các mã hàng có 4 ký tự cuối na ná giống nhau chẳng hạn: zzz1234 và zzz4213 , zzz7586 và zzz8765...
Em muốn tìm ra các cặp mã hàng này trong danh sách phát hàng của ngày hôm đó để các bạn tập trung hơn vào và cũng để dễ dàng thanh kiểm tra đột xuất .

Cụ thể trong file : từ cột A của sheet1 tìm ra kết quả ở cột G của sheet2

Em úp file mong cả nhà hổ trợ. Cám ơn mọi người đã lắng nghe và chia sẽ !!!

vu_tuan_manh_linh · 23/12/15

Yêu cầu của bạn không rõ ràng. Bạn nói rõ hơn đi.

khoa140383 · 23/12/15

vu_tuan_manh_linh đã viết:
Yêu cầu của bạn không rõ ràng. Bạn nói rõ hơn đi.

Cám ơn vu_tuan_manh_linh đã quan tâm nhé.
VD như thế này : mã hàng thứ nhất có 4 số cuối lần lượt là "1","2","3","4" sau đó dò trong bảng mã, nếu có mã hàng nào chứa 4 số trên thì lọc ra như các mã hàng : ...2314, ...4321, ... 2134, ... 4123 .... v.v... sau đó cho vào danh sách "các mã hàng có 4 chữ số na ná giống nhau". Lần lượt đến hết danh sách... Suy nghĩ nát óc mà không ra... hjx...
|||||

concogia · 23/12/15

khoa140383 đã viết:
Cám ơn vu_tuan_manh_linh đã quan tâm nhé.
VD như thế này : mã hàng thứ nhất có 4 số cuối lần lượt là "1","2","3","4" sau đó dò trong bảng mã, nếu có mã hàng nào chứa 4 số trên thì lọc ra như các mã hàng : ...2314, ...4321, ... 2134, ... 4123 .... v.v... sau đó cho vào danh sách "các mã hàng có 4 chữ số na ná giống nhau". Lần lượt đến hết danh sách... Suy nghĩ nát óc mà không ra... hjx...

Theo mình thì "hông" phải "na ná" giống nhau mà phải "hoàn toàn" giống nhau chỉ có điều thứ tự nó...."lung tung xèng"
Thử code này, viết tạm chưa lường hết các tình huống vì bài này......"hông" phải của mình

Mã:

Public Sub ToTe()
    Dim Vung, I, J, K, kK, TamA, TamB, A, B, iDem, Kq, KiemTra
    Vung = Range([A2], [A50000].End(xlUp))
    ReDim Kq(1 To UBound(Vung), 1 To 1)
        For I = 1 To UBound(Vung) - 1
            TamA = Right(Vung(I, 1), 4)
            If InStr(KiemTra, " " & Vung(I, 1) & " ") = 0 Then
                A = Val(Mid(TamA, 1, 1)) + Val(Mid(TamA, 2, 1)) + Val(Mid(TamA, 3, 1)) + Val(Mid(TamA, 4, 1))
                    For J = I + 1 To UBound(Vung)
                        TamB = Right(Vung(J, 1), 4)
                        B = Val(Mid(TamB, 1, 1)) + Val(Mid(TamB, 2, 1)) + Val(Mid(TamB, 3, 1)) + Val(Mid(TamB, 4, 1))
                        If A = B Then
                            For K = 1 To 4
                                If InStr(TamA, Mid(TamB, K, 1)) Then iDem = iDem + 1
                                If InStr(TamB, Mid(TamA, K, 1)) Then iDem = iDem + 1
                            Next K
                            If iDem = 8 Then
                                If InStr(KiemTra, " " & Vung(I, 1) & " ") = 0 Then kK = kK + 1: Kq(kK, 1) = Vung(I, 1)
                                kK = kK + 1: Kq(kK, 1) = Vung(J, 1)
                                KiemTra = KiemTra & " " & Vung(I, 1) & " " & Vung(J, 1) & " "
                            End If
                        End If
                        iDem = 0
                    Next J
             End If
        Next I
  Sheets("sheet2").[I2:I500].ClearContents
  Sheets("sheet2").[I2].Resize(kK) = Kq
End Sub

Thân
Đứng ở sheet 1 chạy code, kết quả cột I sheet 2

khoa140383 · 23/12/15

Ấu zeee.... Xin đa tạ concogia nhiều lắm... chạy thử thì thấy code chính xoác roài đấy và cũng chưa thấy lỗi lầm gì...
Bao giờ thấy lỗi lầm thì ngâm cứu tiếp... hj... --=0

>> Đúng là "lung tung xèng" chứ không phải "na ná"... tuy nhiên khi sai sót các bạn trong team hay dùng từ này nên thành thói quen, sử dụng luôn... hj hj...

MERRY CHRISTMAS !!!! /-*+/

seikoqn · 23/12/15

concogia đã viết:

Theo mình thì "hông" phải "na ná" giống nhau mà phải "hoàn toàn" giống nhau chỉ có điều thứ tự nó...."lung tung xèng"
Thử code này, viết tạm chưa lường hết các tình huống vì bài này......"hông" phải của mình

Mã:

Public Sub ToTe()
    Dim Vung, I, J, K, kK, TamA, TamB, A, B, iDem, Kq, KiemTra
    Vung = Range([A2], [A50000].End(xlUp))
    ReDim Kq(1 To UBound(Vung), 1 To 1)
        For I = 1 To UBound(Vung) - 1
            TamA = Right(Vung(I, 1), 4)
            If InStr(KiemTra, " " & Vung(I, 1) & " ") = 0 Then
                A = Val(Mid(TamA, 1, 1)) + Val(Mid(TamA, 2, 1)) + Val(Mid(TamA, 3, 1)) + Val(Mid(TamA, 4, 1))
                    For J = I + 1 To UBound(Vung)
                        TamB = Right(Vung(J, 1), 4)
                        B = Val(Mid(TamB, 1, 1)) + Val(Mid(TamB, 2, 1)) + Val(Mid(TamB, 3, 1)) + Val(Mid(TamB, 4, 1))
                        If A = B Then
                            For K = 1 To 4
                                If InStr(TamA, Mid(TamB, K, 1)) Then iDem = iDem + 1
                                If InStr(TamB, Mid(TamA, K, 1)) Then iDem = iDem + 1
                            Next K
                            If iDem = 8 Then
                                If InStr(KiemTra, " " & Vung(I, 1) & " ") = 0 Then kK = kK + 1: Kq(kK, 1) = Vung(I, 1)
                                kK = kK + 1: Kq(kK, 1) = Vung(J, 1)
                                KiemTra = KiemTra & " " & Vung(I, 1) & " " & Vung(J, 1) & " "
                            End If
                        End If
                        iDem = 0
                    Next J
             End If
        Next I
  Sheets("sheet2").[I2:I500].ClearContents
  Sheets("sheet2").[I2].Resize(kK) = Kq
End Sub

Thân
Đứng ở sheet 1 chạy code, kết quả cột I sheet 2

Mình test thấy thiếu số"1187238960"

concogia · 23/12/15

seikoqn đã viết:
Mình test thấy thiếu số"1187238960"

Mình thấy vẫn có
1187238960 & 1187236890

chuot0106 · 23/12/15

khoa140383 đã viết:
Cám ơn vu_tuan_manh_linh đã quan tâm nhé.
VD như thế này : mã hàng thứ nhất có 4 số cuối lần lượt là "1","2","3","4" sau đó dò trong bảng mã, nếu có mã hàng nào chứa 4 số trên thì lọc ra như các mã hàng : ...2314, ...4321, ... 2134, ... 4123 .... v.v... sau đó cho vào danh sách "các mã hàng có 4 chữ số na ná giống nhau". Lần lượt đến hết danh sách... Suy nghĩ nát óc mà không ra... hjx...

Chạy code này xem kết quả ra sao!

Mã:

Public Sub mix()
Dim dl(), Kq(), I As Long, J As Long, bkt1 As String, bkt2 As String, d As Long, dem As Long, K As Long, dk As Long, t1 As Long, t2 As Long
dl = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
ReDim Kq(1 To 10000, 1 To 1)
For I = 1 To UBound(dl)
bkt1 = Right(dl(I, 1), 4): t1 = Val(Mid(bkt1, 1, 1)) + Val(Mid(bkt1, 2, 1)) + Val(Mid(bkt1, 3, 1)) + Val(Mid(bkt1, 4, 1))
    For J = I + 1 To UBound(dl)
            dem = 0: bkt2 = Right(dl(J, 1), 4): t2 = Val(Mid(bkt2, 1, 1)) + Val(Mid(bkt2, 2, 1)) + Val(Mid(bkt2, 3, 1)) + Val(Mid(bkt2, 4, 1))
        If t1 = t2 Then
            For K = 1 To 4
                dk = InStr(1, bkt1, Mid(bkt2, K, 1))
                If dk > 0 Then dem = dem + 1
            Next K
                If dem = 4 Then
                    d = d + 1
                    Kq(d, 1) = dl(I, 1)
                    d = d + 1
                    Kq(d, 1) = dl(J, 1)
                End If
        End If
    Next J
Next I
        Sheet2.Range("h2").Resize(100) = Kq
End Sub

huuthang_bd · 23/12/15

chuot0106 đã viết:

Chạy code này xem kết quả ra sao!

Mã:

Public Sub mix()
Dim dl(), Kq(), I As Long, J As Long, bkt1 As String, bkt2 As String, d As Long, dem As Long, K As Long, dk As Long, t1 As Long, t2 As Long
dl = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
ReDim Kq(1 To 10000, 1 To 1)
For I = 1 To UBound(dl)
bkt1 = Right(dl(I, 1), 4): t1 = Val(Mid(bkt1, 1, 1)) + Val(Mid(bkt1, 2, 1)) + Val(Mid(bkt1, 3, 1)) + Val(Mid(bkt1, 4, 1))
    For J = I + 1 To UBound(dl)
            dem = 0: bkt2 = Right(dl(J, 1), 4): t2 = Val(Mid(bkt2, 1, 1)) + Val(Mid(bkt2, 2, 1)) + Val(Mid(bkt2, 3, 1)) + Val(Mid(bkt2, 4, 1))
        If t1 = t2 Then
            For K = 1 To 4
                dk = InStr(1, bkt1, Mid(bkt2, K, 1))
                If dk > 0 Then dem = dem + 1
            Next K
                If dem = 4 Then
                    d = d + 1
                    Kq(d, 1) = dl(I, 1)
                    d = d + 1
                    Kq(d, 1) = dl(J, 1)
                End If
        End If
    Next J
Next I
        Sheet2.Range("h2").Resize(100) = Kq
End Sub

Chạy rồi và thấy kết quả trật lất.

T/B: Nếu không phải là 4 số cuối mà là nhiều hơn thì thuật toán ở bài #4 cũng không xài được luôn.

concogia · 23/12/15

huuthang_bd đã viết:
Chạy rồi và thấy kết quả trật lất.

T/B: Nếu không phải là 4 số cuối mà là nhiều hơn thì thuật toán ở bài #4 cũng không xài được luôn.

Đề bài là 3 hoặc 4 số cuối. Nếu không xác định thì giải kiểu khác
Cái này chắc là "dzụ kia" í mà, nên chắc chỉ 3 & 4 số cuối thôi

SA_DQ · 23/12/15

Trước tiên cần fải thỏa thuận với nhau là sẽ fải đi tìm tổ hợp của 4 kí số này;
Giả thiết chúng có thể trùng hay không trùng (ví dụ 1010, hay 1119 ; 1234)
Hình như trên diễn đàn ta có loạt bài về vấn đề này.

Tìm thấy rồi: http://www.giaiphapexcel.com/forum/...ới-bài-toán-ABCDE-FGHIJ-9&p=257264#post257264

Còn chuyện tìm trong cột có chúng hay không là chuyện không lớn lắm.

khoa140383 · 24/12/15

concogia đã viết:
Đề bài là 3 hoặc 4 số cuối. Nếu không xác định thì giải kiểu khác
Cái này chắc là "dzụ kia" í mà, nên chắc chỉ 3 & 4 số cuối thôi

Cái này không phải là "dzụ kia" đâu concogia ơi... Tại team hay mần sai các mã hàng giống giống nhau như thế này nên mình mần cái file cho các bạn thủ kho tập trung vào các mã hàng dễ bị sai sót thôi à ( kho hardware ). Còn cái "dzụ kia" trên android có nhiều roài, cần gì phải vào ếch seo code kiếc chi cho mệt... hj...

Chúc các bạn giáng sinh vui vẻ nhé !!! /-*+/

SA_DQ · 24/12/15

Bạn thử với macro sự kiện này tại ô [B2] của Sheet2 xem sao:

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [b2]) Is Nothing Then
    Dim Sh As Worksheet, Rng As Range, sRng As Range
    Dim J As Long
    
    Set Sh = ThisWorkbook.Sheets("sheet1")
    Set Rng = Sh.Columns("A:A")
    For J = 1 To 24
        Set sRng = Rng.Find(BonSo(Target.Value, J), , xlFormulas, xlPart)
        If Not sRng Is Nothing Then
            [d65500].End(xlUp).Offset(1).Value = sRng.Value
        End If
    Next J
 End If
End Sub

Mã:

[b]
Function BonSo(Num As Long, J As Long)[/b]
 Dim Ngan As Byte, Tram As Byte, Chuc As Byte, DVi As Byte
 If Num < 1000 Then
    Ngan = 0
 Else
    Ngan = Num \ 1000
 End If
 Tram = Num \ 100 Mod 10
 Chuc = Num \ 10 Mod 10
 DVi = Num Mod 10
 
 If J = 1 Then BonSo = Num
 If J = 2 Then BonSo = Ngan * 1000 + Tram * 100 + DVi * 10 + Chuc
 If J = 3 Then BonSo = Ngan * 1000 + Chuc * 100 + DVi * 10 + Tram
 If J = 4 Then BonSo = Ngan * 1000 + Chuc * 100 + Tram * 10 + DVi
 If J = 5 Then BonSo = Ngan * 1000 + DVi * 100 + Chuc * 10 + Tram
 If J = 6 Then BonSo = Ngan * 1000 + DVi * 100 + Tram * 10 + Chuc
  
 If J = 7 Then BonSo = Tram * 1000 + Ngan * 100 + Chuc * 10 + DVi
 If J = 8 Then
    BonSo = Tram * 1000 + Ngan + 100 + DVi * 10 + Chuc   '
  End If
 If J = 9 Then BonSo = Tram * 1000 + Chuc + 100 + Ngan * 10 + DVi   '
 If J = 10 Then BonSo = Tram * 1000 + Chuc * 100 + DVi * 10 + Ngan
 If J = 11 Then BonSo = Tram * 1000 + DVi * 100 + Ngan * 10 + Chuc
 If J = 12 Then BonSo = Tram * 1000 + DVi * 100 + Chuc * 10 + Ngan
 
 If J = 13 Then BonSo = Chuc * 1000 + Ngan * 100 + Tram * 10 + DVi
 If J = 14 Then BonSo = Chuc * 1000 + Ngan * 100 + DVi * 10 + Tram
 If J = 15 Then BonSo = Chuc * 1000 + Tram * 100 + Ngan * 10 + DVi
 If J = 16 Then BonSo = Chuc * 1000 + Tram * 100 + DVi * 10 + Ngan
 If J = 17 Then BonSo = Chuc * 1000 + DVi * 100 + Ngan * 10 + Tram
 If J = 18 Then BonSo = Chuc * 1000 + DVi * 100 + Tram * 10 + Ngan
 
 If J = 19 Then BonSo = DVi * 1000 + Ngan * 100 + Tram * 10 + Chuc
 If J = 20 Then BonSo = DVi * 1000 + Ngan * 100 + Chuc * 10 + Tram
 If J = 21 Then BonSo = DVi * 1000 + Tram * 100 + Ngan * 10 + Chuc
 If J = 22 Then BonSo = DVi * 1000 + Tram * 100 + Chuc * 10 + Ngan
 If J = 23 Then BonSo = DVi * 1000 + Chuc * 100 + Ngan * 10 + Tram
 If J = 24 Then BonSo = DVi * 1000 + Chuc * 100 + Tram * 10 + Ngan
[b]End Function[/b]

khoa140383 · 24/12/15

Hình như HYen17chưa hiểu ý mình thì phải... Nhưng không sao, concogia đã mần ra giúp mình rồi... Cám ơn HYen17 nhiều lằm nhé !!! /-*+/

VetMini · 24/12/15

Chỉ có 4 số thì cho vòng lặp chạy từ 0 đến 9999, xét xem số nào chứa đủ 4 ký tự thì lấy. Thuật toán tối ưu này nọ mần chi mệt lắm.

Bài toán tìm 4 con số cuối trong dãy ký tự bị mix với nhau. (1 người xem)

Người dùng đang xem chủ đề này

khoa140383

Thành viên hoạt động

File đính kèm

vu_tuan_manh_linh

linhvtm84@gmail.com

khoa140383

Thành viên hoạt động

concogia

Gội rồi mới Cạo

khoa140383

Thành viên hoạt động

seikoqn

Thành viên hoạt động

concogia

Gội rồi mới Cạo

chuot0106

Thành viên gắn bó

File đính kèm

huuthang_bd

Chuyên gia GPE

concogia

Gội rồi mới Cạo

SA_DQ

/(hông là gì!

khoa140383

Thành viên hoạt động

SA_DQ

/(hông là gì!

khoa140383

Thành viên hoạt động

VetMini

Ăn cùng góc phố

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian