Báo trùng dữ liệu khi quét mã vạch

[Congky74]

Kính gửi các anh chị trên Diễn Đàn!
Em có file excel chuyên dùng để quét mã vạch. mỗi ngày em mở 1 sheet. (từ sheet 01 đến sheet 31), dữ liệu quét là cột A của các sheet.
để nhận biết mã vạch trùng nhau giữa các sheet, hoặc trong cùng 1 sheet thì báo đỏ hoặc to màu mã vạch trùng đó và cột B tương ứng hiển thị tên sheet trùng. em có ví dụ trong file em làm thủ công trước 3 sheet: 01, 02, 03.
Rất mong các anh chị giúp em !
em xin chân thành cảm ơn!

 

[anhdepjai]

Bạn mở sheet nào thì nó tự điền dữ liệu mong muốn cho sheet đó, cột C

 

[Congky74]

Bạn mở sheet nào thì nó tự điền dữ liệu mong muốn cho sheet đó, cột C

Cảm ơn bạn đã quan tâm và giúp mình
Ý mình là khi nhân viên đang thực hiện quét mã vạch, nếu trùng là báo màu luôn để biết mã đó trùng mà loại ra. thay vì phải chuyển sheet mới hiển thị trùng, vì quét mã liên tục và đóng thùng xuất luôn. Nhờ bạn và mọi người giúp mình với!
Xin chân thành cảm ơn!

 

[Congky74]

Kính gửi các anh chị trên Diễn Đàn!
Em có file excel chuyên dùng để quét mã vạch. mỗi ngày em mở 1 sheet. (từ sheet 01 đến sheet 31), dữ liệu quét là cột A của các sheet.
để nhận biết mã vạch trùng nhau giữa các sheet, hoặc trong cùng 1 sheet thì báo đỏ hoặc to màu mã vạch trùng đó và cột B tương ứng hiển thị tên sheet trùng. em có ví dụ trong file em làm thủ công trước 3 sheet: 01, 02, 03.
Rất mong các anh chị giúp em !
em xin chân thành cảm ơn!

Nhờ Thầy @Ba Tê giúp con với ạ!

 

[snow25]

Kính gửi các anh chị trên Diễn Đàn!
Em có file excel chuyên dùng để quét mã vạch. mỗi ngày em mở 1 sheet. (từ sheet 01 đến sheet 31), dữ liệu quét là cột A của các sheet.
để nhận biết mã vạch trùng nhau giữa các sheet, hoặc trong cùng 1 sheet thì báo đỏ hoặc to màu mã vạch trùng đó và cột B tương ứng hiển thị tên sheet trùng. em có ví dụ trong file em làm thủ công trước 3 sheet: 01, 02, 03.
Rất mong các anh chị giúp em !
em xin chân thành cảm ơn!

Bạn thử cái code này nhé.

Sub laygiatritrung()
    Dim arr, i As Long, dic As Object, lr As Long, dk As String, sh As Worksheet, a As Long, s As String
    Set dic = CreateObject("scripting.dictionary")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value <> Empty Then
           lr = sh.Range("A" & Rows.Count).End(xlUp).Row
           sh.Range("B1:B" & lr).Clear
           sh.Range("A1:A" & lr).Font.ColorIndex = xlAutomatic
           arr = sh.Range("A1:B" & lr).Value
           For i = 1 To UBound(arr)
               dk = arr(i, 1)
               If Not dic.exists(dk) Then
                  dic.Add dk, Array(1, sh.Name)
               Else
                  a = dic.Item(dk)(0) + 1
                  s = dic.Item(dk)(1)
                  s = s & "," & sh.Name
                  dic.Item(dk) = Array(a, s)
               End If
           Next i
        End If
    Next
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value <> Empty Then
           lr = sh.Range("A" & Rows.Count).End(xlUp).Row
           arr = sh.Range("A1:B" & lr).Value
           For i = 1 To UBound(arr)
               dk = arr(i, 1)
               a = dic.Item(dk)(0)
               If a > 1 Then
                  arr(i, 2) = dic.Item(dk)(1)
                  sh.Range("A" & i).Font.ColorIndex = 3
                  sh.Range("B" & i).Interior.ColorIndex = 6
               End If
           Next i
           sh.Range("A1:B" & lr).Value = arr
        End If
   Next
End Sub

 

[Congky74]

Bạn thử cái code này nhé.

Sub laygiatritrung()
    Dim arr, i As Long, dic As Object, lr As Long, dk As String, sh As Worksheet, a As Long, s As String
    Set dic = CreateObject("scripting.dictionary")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value <> Empty Then
           lr = sh.Range("A" & Rows.Count).End(xlUp).Row
           sh.Range("B1:B" & lr).Clear
           sh.Range("A1:A" & lr).Font.ColorIndex = xlAutomatic
           arr = sh.Range("A1:B" & lr).Value
           For i = 1 To UBound(arr)
               dk = arr(i, 1)
               If Not dic.exists(dk) Then
                  dic.Add dk, Array(1, sh.Name)
               Else
                  a = dic.Item(dk)(0) + 1
                  s = dic.Item(dk)(1)
                  s = s & "," & sh.Name
                  dic.Item(dk) = Array(a, s)
               End If
           Next i
        End If
    Next
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value <> Empty Then
           lr = sh.Range("A" & Rows.Count).End(xlUp).Row
           arr = sh.Range("A1:B" & lr).Value
           For i = 1 To UBound(arr)
               dk = arr(i, 1)
               a = dic.Item(dk)(0)
               If a > 1 Then
                  arr(i, 2) = dic.Item(dk)(1)
                  sh.Range("A" & i).Font.ColorIndex = 3
                  sh.Range("B" & i).Interior.ColorIndex = 6
               End If
           Next i
           sh.Range("A1:B" & lr).Value = arr
        End If
   Next
End Sub

Cảm ơn anh nhiều. code chạy đúng ý em. nhưng anh ơi mỗi lần quét là phải thực hiện chạy code mới được, anh có thể hướng dẫn em làm Worksheet_Change để tự động được không anh.

 

[snow25]

Cảm ơn anh nhiều. code chạy đúng ý em. nhưng anh ơi mỗi lần quét là phải thực hiện chạy code mới được, anh có thể hướng dẫn em làm Worksheet_Change để tự động được không anh.

Đây bạn xem.Vì cái này nó duyệt qua tất cả các sheets nên code chạy sẽ chậm nhé.

 

[Congky74]

Đây bạn xem.Vì cái này nó duyệt qua tất cả các sheets nên code chạy sẽ chậm nhé.

em thử mà nó vẫn không chạy anh ơi!
Anh giúp em lại với

 

[snow25]

em thử mà nó vẫn không chạy anh ơi! View attachment 222483
Anh giúp em lại với

Bạn đã Enable code chưa vậy.

 

[Congky74]

Bạn đã Enable code chưa vậy.
View attachment 222486

đã bật chế độ sẵn rồi mà vẫn không tự động anh ơi!

 

[snow25]

View attachment 222488
đã bật chế độ sẵn rồi mà vẫn không tự động anh ơi!

Bạn xem code sự kiện mình đặt ở workbook đó.Bạn vào đó xem nhé.Thử chạy code xem nó báo gì không.

 

[Congky74]

Bạn xem code sự kiện mình đặt ở workbook đó.Bạn vào đó xem nhé.Thử chạy code xem nó báo gì không.

Nó báo vậy anh ơi!

 

[Phuocam]

để nhận biết mã vạch trùng nhau giữa các sheet

Dễ nhất là tạo thêm 1 sheet tổng hợp, rồi dùng Vlookup., hoặc dùng định dạng có điều kiện.

 

[Congky74]

View attachment 222490
Nó báo vậy anh ơi!

Lý do là em nhập tay thử chưa đủ 23 ký tự. nên báo lỗi "Type mismath" . nhưng dùng máy quét thì nó không báo lỗi này nhưng vẫn chưa tự động. khi chạy code sự kiện ở workbook thì mới nhận ra kết quả

Bài đã được tự động gộp: 8/8/19

Dễ nhất là tạo thêm 1 sheet tổng hợp, rồi dùng Vlookup., hoặc dùng định dạng có điều kiện.

Cảm ơn anh đã gợi ý cho em! em sẽ vận dụng ạ!

 

[Congky74]

Bạn xem code sự kiện mình đặt ở workbook đó.Bạn vào đó xem nhé.Thử chạy code xem nó báo gì không.

em cảm ơn anh rất nhiều. em restart máy lại thì nó chạy Ok rồi anh ơi.

 

[Congky74]

Đây bạn xem.Vì cái này nó duyệt qua tất cả các sheets nên code chạy sẽ chậm nhé.

Chào anh @snow25 ! cảm ơn anh đã dành thời gian viết code cho em lần trước. qua sử dụng code chạy rất tốt anh ạ!
Tuy nhiên có phát sinh thêm một trường hợp là: bộ mã em đang dùng hiện tại là có 23 ký tự, 12 ký đầu là thể hiện tên của từng sản phẩm, nên nếu trong file này có nhập thêm mã sản phẩm khác mà có 12 ký tự đầu khác là báo sai mã và to màu đỏ. và anh có thể viết thêm cho em mỗi lần trùng mã đều xuất hiện hộp thoại báo trùng để không cho nhập liệu hoặc chọn Yes-No mới cho nhập . Em gửi file đính kèm
em cám ơn anh rất nhiều!