Code VBA báo trùng tên hàng hóa (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Rùa Con 1080

Rùa Con 1080

Thành Viên Sao Chép 2
Tham gia
4/5/16
Bài viết
351
Được thích
47
Giới tính
Nữ
Chào mọi người!!! Em có bảng nhập tên hàng hóa từ A3:A400. Em có tham khảo cách dùng validation (=CountIf($A$3:A3,A3)=1) nhưng chưa thỏa. Vì cách này chỉ đúng với Mã hàng hóa. Còn của em là tên hàng hóa ví dụ như Bột ngọt, Đường, Muối, tiêu, Bột Ngọt Loại 1, Bột Ngọt Loại 2,,,v,,v,v,v,, và nhiêù khi lỗi gỏ như Bột Ngọt Loại1(không có khoảng trắng gi7ua4 Loại và 1)
Em muốn nhờ Mọi người viết code dùm trong sự kiện Worksheet_Change.
Em xin cám Ơn.
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Rùa Con 1080 đã viết:
Chào mọi người!!! Em có bảng nhập tên hàng hóa từ A3:A400. Em có tham khảo cách dùng validation (=CountIf($A$3:A3,A3)=1) nhưng chưa thỏa. Vì cách này chỉ đúng với Mã hàng hóa. Còn của em là tên hàng hóa ví dụ như Bột ngọt, Đường, Muối, tiêu, Bột Ngọt Loại 1, Bột Ngọt Loại 2,,,v,,v,v,v,, và nhiêù khi lỗi gỏ như Bột Ngọt Loại1(không có khoảng trắng gi7ua4 Loại và 1)
Em muốn nhờ Mọi người viết code dùm trong sự kiện Worksheet_Change.
Em xin cám Ơn.
Nhấp chuột vào đây để mở rộng...
Nếu không có khoảng trắng ở giữa và có khoảng trắng ở giữa có báo là trùng hay không?Mà có file mãu mới giúp được bạn ơi.
 
Upvote 0
Dạ em xin đưa file, mong các AC giúp đõ. Em có thấy sử dụng Trim để cắt khoảng trắng, có thể dùng Trim để cắt khoảng trăng được không ah??? Có khoảng trắng ở giữa và không có khoảng trắng ơ3 giữa đếu báo hết Anh ơi. Vì như Nước Tương Loại 1 và Nước Tương Loai1 đều giống nhau.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Rùa Con 1080 đã viết:
Dạ em xin đưa file, mong các AC giúp đõ. Em có thấy sử dụng Trim để cắt khoảng trắng, có thể dùng Trim để cắt khoảng trăng được không ah??? Có khoảng trắng ở giữa và không có khoảng trắng ơ3 giữa đếu báo hết Anh ơi. Vì như Nước Tương Loại 1 và Nước Tương Loai1 đều giống nhau.
Nhấp chuột vào đây để mở rộng...
'Loại 1' rất khác 'Loại1' . Năm 2013, tôi gặp tình huống này, cũng nhờ các sư phụ trên GPE nay pót lai ko biết giúp bạn được ko?!
 

File đính kèm

Upvote 0
Rùa Con 1080 đã viết:
Dạ em xin đưa file, mong các AC giúp đõ. Em có thấy sử dụng Trim để cắt khoảng trắng, có thể dùng Trim để cắt khoảng trăng được không ah??? Có khoảng trắng ở giữa và không có khoảng trắng ơ3 giữa đếu báo hết Anh ơi. Vì như Nước Tương Loại 1 và Nước Tương Loai1 đều giống nhau.
Nhấp chuột vào đây để mở rộng...
Bạn sử dụng code này thử xem.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sCell As Range, k As Integer
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
[A3:A65000].Interior.Pattern = xlNone
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) Then
            sCell.Interior.Color = 255
            If sCell.Address <> Target.Address Then k = k + 1
       End If
   Next
End If
If k = 0 Then Target.Interior.Pattern = xlNone
End Sub
 
Upvote 0
Anh giaiphap có thẻ chỉnh code để nhập trùng thì có msgBox" trung ten hang hoa - xin nhap lai" được không ah!!!!!
Cám ơn Anh.
 
Upvote 0
Rùa Con 1080 đã viết:
Anh giaiphap có thẻ chỉnh code để nhập trùng thì có msgBox" trung ten hang hoa - xin nhap lai" được không ah!!!!!
Cám ơn Anh.
Nhấp chuột vào đây để mở rộng...
vậy bạn sửa code thế này thử xem.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sCell As Range
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) Then
            If sCell.Address <> Target.Address Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
                Exit Sub
            End If
       End If
   Next
End If
End Sub
 
Upvote 0
Đúng rối Anh giaiphap ơi. Cám ơn Anh nhiều!!!!!!!
 
Upvote 0
Anh giaiphap cho em hỏi tí(có gì mong Anh bỏ qua). Nếu vừa có màu đỏ vừa có msgBox thì code làm sao hả Anh????
 
Upvote 0
Em có thêm vào code
Mã: 
[COLOR=#000000]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]Dim sCell As Range
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) Then
           [B][COLOR=#ff0000][FONT=Verdana]sCell.Interior.Color = 255    '<----them vao cho nay[/FONT][/COLOR][/B]
            If sCell.Address <> Target.Address Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
                Application.EnableEvents = False
                [COLOR=#b22222][B]Application.Undo   <-----thi bi loi vang cho nay[/B][/COLOR]
                Application.EnableEvents = True
                Exit Sub
            End If
       End If
   Next
End If [COLOR=#000000]End Sub[/COLOR]
Mong Anh chỉ giáo!!!!!
 
Upvote 0
Rùa Con 1080 đã viết:
Em có thêm vào code
Mã: 
[COLOR=#000000]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]Dim sCell As Range
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) Then
           [B][COLOR=#ff0000][FONT=Verdana]sCell.Interior.Color = 255    '<----them vao cho nay[/FONT][/COLOR][/B]
            If sCell.Address <> Target.Address Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
                Application.EnableEvents = False
                [COLOR=#b22222][B]Application.Undo   <-----thi bi loi vang cho nay[/B][/COLOR]
                Application.EnableEvents = True
                Exit Sub
            End If
       End If
   Next
End If [COLOR=#000000]End Sub[/COLOR]
Mong Anh chỉ giáo!!!!!
Nhấp chuột vào đây để mở rộng...
Bạn sửa lại vầy thử xem.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sCell As Range, kt As Boolean
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
kt = False
Cells.Interior.Pattern = xlNone
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) And sCell.Address <> Target.Address Then
           sCell.Interior.Color = 255    '<----them vao cho nay
            If sCell.Address <> Target.Address Then
                kt = True
            End If
       End If
   Next
    If kt Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
                Application.EnableEvents = False
                Target.Value = Empty
                Target.Select
                Application.EnableEvents = True
     End If
End If
End Sub
 
Upvote 0
Em chèn thêm đoạn code để khi xem cell trùng được tô màu thì nhấn OK của msgBox thì cell trùng lại trở lại cũ (không màu), nhưng lại lỗi. Mong Anh xem giúp
Mã: 
[COLOR=#000000]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]Dim sCell As Range, kt As Boolean
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
kt = False
Cells.Interior.Pattern = xlNone
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) And sCell.Address <> Target.Address Then
           sCell.Interior.Color = 255    '<----them vao cho nay
            If sCell.Address <> Target.Address Then
                kt = True
            End If
       End If
   Next
    If kt Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
                Application.EnableEvents = False
                [B][COLOR=#ff0000]s[FONT=Verdana]Cells.Interior.Pattern = xlNone  <---em  ch[/FONT]èn chổ này, nhưng lỗi[/COLOR][/B]
                Target.Value = Empty
                Target.Select
                Application.EnableEvents = True
     End If
End If [COLOR=#000000]End Sub[/COLOR]
 
Upvote 0
Rùa Con 1080 đã viết:
Em chèn thêm đoạn code để khi xem cell trùng được tô màu thì nhấn OK của msgBox thì cell trùng lại trở lại cũ (không màu), nhưng lại lỗi. Mong Anh xem giúp
Mã: 
[COLOR=#000000]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]Dim sCell As Range, kt As Boolean
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
kt = False
Cells.Interior.Pattern = xlNone
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) And sCell.Address <> Target.Address Then
           sCell.Interior.Color = 255    '<----them vao cho nay
            If sCell.Address <> Target.Address Then
                kt = True
            End If
       End If
   Next
    If kt Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
                Application.EnableEvents = False
                [B][COLOR=#ff0000]s[FONT=Verdana]Cells.Interior.Pattern = xlNone  <---em  ch[/FONT]èn chổ này, nhưng lỗi[/COLOR][/B]
                Target.Value = Empty
                Target.Select
                Application.EnableEvents = True
     End If
End If [COLOR=#000000]End Sub[/COLOR]
Nhấp chuột vào đây để mở rộng...
Cái chổ màu đỏ đó bạn hiểu tác dụng của nó không? chứ tôi thì thua bạn thật rồi.
 
Upvote 0
em hiểu nó làm cho cell được tô màu thành trắng(không màu) phải không Anh. Nếu có gì sai mong Anh bỏ qua. Mong ANh giúp sau khi xem xong cell được tô màu xong thì nhấn OK của msgBox thì cell đó trở về không màu.
 
Upvote 0
Rùa Con 1080 đã viết:
em hiểu nó làm cho cell được tô màu thành trắng(không màu) phải không Anh. Nếu có gì sai mong Anh bỏ qua. Mong ANh giúp sau khi xem xong cell được tô màu xong thì nhấn OK của msgBox thì cell đó trở về không màu.
Nhấp chuột vào đây để mở rộng...
Cái chổ tô màu đỏ đó là ô nào vậy bạn. Nếu là tất cả thì chỉ cần vầy là được.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sCell As Range, kt As Boolean
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
kt = False
Cells.Interior.Pattern = xlNone
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) And sCell.Address <> Target.Address Then
           sCell.Interior.Color = 255    '<----them vao cho nay
            If sCell.Address <> Target.Address Then
                kt = True
            End If
       End If
   Next
    If kt Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
[COLOR=#ff0000][B]                Cells.Interior.Pattern = xlNone[/B][/COLOR]
                Application.EnableEvents = False
                Target.Value = Empty
                Target.Select
                Application.EnableEvents = True
     End If
End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn Anh, em có thử thì thấy như sau:
1/ khi code chạy thì xóa hết màu của các cell trong sheet.(chỉ cần xóa A3:A1000)
2/ khi nhần OK của msgBox thì lỗi "424' Object riquired.
Mã: 
[COLOR=#000000]Private Sub Worksheet_Change(ByVal Target As Range)
[/COLOR]Dim sCell As Range, kt As Boolean
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
kt = False
Cells.Interior.Pattern = xlNone
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) And sCell.Address <> Target.Address Then
           sCell.Interior.Color = 255    '<----them vao cho nay
            If sCell.Address <> Target.Address Then
                kt = True
            End If
       End If
   Next
    If kt Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
[COLOR=#ff0000][B]                Cells.Interior.Pattern = xlNone <-----bi loi vang cho nay[/B][/COLOR]
                Application.EnableEvents = False
                Target.Value = Empty
                Target.Select
                Application.EnableEvents = True
     End If
End If [COLOR=#000000]End Sub[/COLOR]
Mong Anh xem giúp!!!!!
 
Lần chỉnh sửa cuối:
Upvote 0
Rùa Con 1080 đã viết:
Cám ơn Anh, em có thử thì thấy như sau:
1/ khi code chạy thì xóa hết màu của các cell trong sheet.(chỉ cần xóa A3:A1000)
2/ khi nhần OK của msgBox thì lỗi "424' Object riquired.
Mã: 
[COLOR=#000000]Private Sub Worksheet_Change(ByVal Target As Range)
[/COLOR]Dim sCell As Range, kt As Boolean
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
kt = False
Cells.Interior.Pattern = xlNone
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) And sCell.Address <> Target.Address Then
           sCell.Interior.Color = 255    '<----them vao cho nay
            If sCell.Address <> Target.Address Then
                kt = True
            End If
       End If
   Next
    If kt Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
[COLOR=#ff0000][B]                Cells.Interior.Pattern = xlNone <-----bi loi vang cho nay[/B][/COLOR]
                Application.EnableEvents = False
                Target.Value = Empty
                Target.Select
                Application.EnableEvents = True
     End If
End If [COLOR=#000000]End Sub[/COLOR]
Mong Anh xem giúp!!!!!
Nhấp chuột vào đây để mở rộng...
Sao mình chạy báo lỗi gì đâu nhĩ, bạn xem file. Nếu muốn không bị ảnh hưởng màu của những cột khác hãy sửa chổ màu đỏ.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sCell As Range, kt As Boolean
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, [a3:a1000]) Is Nothing Then
kt = False
[COLOR=#ff0000][B]Range("A3:A1000")[/B][/COLOR].Interior.Pattern = xlNone
   For Each sCell In Range("A3:A" & Range("A65000").End(xlUp).Row)
       If UCase(Replace(sCell.Value, " ", "")) = UCase(Replace(Target.Value, " ", "")) [COLOR=#000000][I]And sCell.Address <> Target.Address [/I][/COLOR]Then
           sCell.Interior.Color = 255
            If sCell.Address <> Target.Address Then
                kt = True
            End If
       End If
   Next
    If kt Then
                MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
                [COLOR=#ff0000][B]Range("A3:A1000")[/B][/COLOR].Interior.Pattern = xlNone
                Application.EnableEvents = False
                Target.Value = Empty
                Target.Select
                Application.EnableEvents = True
     End If
End If
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Thế còn chỉ cần xóa những cell trùng trong cột A thôi, mong Anh giúp. Em đưa bài lên thì thấy Anh đã trả lời. Thật Cám Ơn Anh nhiều!!!!!!
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

SA_DQ
[Xin hỏi] Cách tính số tiền bình quân của tài khoản trong 1 tháng (1 người xem)
Trả lời
15
Đọc
251
ptm0412
ptm0412
dangvandang
Addin mở rộng cho xây dựng (3 người xem)
    • Thích
2
Trả lời
34
Đọc
3K
vlba
V
M
  • Question Question
Tự chèn dòng khi cập nhật dữ liệu từ trang tính khác.
Trả lời
4
Đọc
107
mtbackup
M
N
Xin giúp e cách lọc dữ liệu bị trùng
Trả lời
3
Đọc
152
hoangtuaotrang_hp_vn
H
A
ExTools : Hơn 60 tính năng bổ sung cho Excel (1 người xem)
    • Thích
Trả lời
3
Đọc
9K
mangat060083
M
anhtuan1066
  • Question Question
Đọc số thành chữ có phần thập phân
Trả lời
12
Đọc
8K
caocat
C
A
  • Question Question
Nhờ anh chị em chú bác giúp em viết code vba thay cho công thức dò tìm và tính
Trả lời
2
Đọc
108
A HOANG 620
A
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711) (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
262
Đọc
28K
toptikibeauty
T
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Cười
Trả lời
3
Đọc
154
minhminh27
minhminh27
nttrung_proneu
Cách giữ công thức khi lọc và tách file
Trả lời
2
Đọc
93
nttrung_proneu
nttrung_proneu
K
  • Question Question
Code vba đọc QR code file hình ảnh trên CCCD (1 người xem)
    • Cười
Trả lời
0
Đọc
109
kingbo.camera
K
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
42
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
  • Question Question
Gửi mail hàng loạt với mỗi mail là 1 file PDF đính kèm khác nhau (1 người xem)
Trả lời
1
Đọc
87
minhminh27
minhminh27
B
Làm sao đổi đơn vị B, M này sang hàng đơn vị vậy mọi người?
    • Cười
Trả lời
4
Đọc
87
Bao Nguyen 89
B
C
Tạo hyperlink hàng loạt
Trả lời
9
Đọc
5K
online.tanphat
O
TrungChinhs
  • Question Question
Hỏi cách làm tròn số trong VBA
Trả lời
9
Đọc
7K
SA_DQ
SA_DQ
dongbhhg
Tìm lương cơ sở theo từng tháng
Trả lời
3
Đọc
108
dongbhhg
dongbhhg
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel
Trả lời
12
Đọc
11K
Gà Công Nghệ
Gà Công Nghệ
N
Thử lập trình XLL add-in bằng C/C++
    • Thích
Trả lời
0
Đọc
124
nguyendang95
N
Tuấn Bụng Bự
tạo QRcode chuyển khoản ngân hàng
Trả lời
5
Đọc
238
Tuấn Bụng Bự
Tuấn Bụng Bự
Xem thêm…

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

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom