Trang 2 của 3 Đầu tiênĐầu tiên 123 CuốiCuối
Kết quả 11 đến 20 của 29

Chủ đề: Code VBA báo trùng tên hàng hóa

  1. #11
    thichduthu Guest
    Em có thêm vào code

    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
               sCell.Interior.Color = 255    '<----them vao cho nay
                If sCell.Address <> Target.Address Then
                    MsgBox "Du lieu da bi trung, de nghi ban nhap lai"
                    Application.EnableEvents = False
                    Application.Undo   <-----thi bi loi vang cho nay
                    Application.EnableEvents = True
                    Exit Sub
                End If
           End If
       Next
    End If End Sub
    Mong Anh chỉ giáo!!!!!

  2. #12
    ungbuouhungviet01 Guest
    [QUOTE="Rùa Con 1080"]Em có thêm vào code

    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

  3. #13
    Ngày tham gia
    Aug 2015
    Bài viết
    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ã:
    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
                    sCells.Interior.Pattern = xlNone  <---em  chèn chổ này, nhưng lỗi
                    Target.Value = Empty
                    Target.Select
                    Application.EnableEvents = True
         End If
    End If End Sub

  4. #14
    hathuan Guest
    Trích dẫn Gửi bởi Rùa Con 1080
    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

    <div class="bbcode_container">
    <div class="bbcode_description">Code:
    </div>
    </div>
    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.

  5. #15
    Ngày tham gia
    Aug 2015
    Bài viết
    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.

  6. #16
    vthao93hp Guest
    Trích dẫn Gửi bởi Rùa Con 1080
    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.
    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"
                    Cells.Interior.Pattern = xlNone
                    Application.EnableEvents = False
                    Target.Value = Empty
                    Target.Select
                    Application.EnableEvents = True
         End If
    End If
    End Sub

  7. #17
    hoabaybay Guest
    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ã:
    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"
                    Cells.Interior.Pattern = xlNone <-----bi loi vang cho nay
                    Application.EnableEvents = False
                    Target.Value = Empty
                    Target.Select
                    Application.EnableEvents = True
         End If
    End If End Sub
    Mong Anh xem giúp!!!!!

  8. #18
    khanhnguyen12021 Guest
    [QUOTE="Rùa Con 1080"]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ã:
    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
    Range("A3:A1000").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
                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"
                    Range("A3:A1000").Interior.Pattern = xlNone
                    Application.EnableEvents = False
                    Target.Value = Empty
                    Target.Select
                    Application.EnableEvents = True
         End If
    End If
    End Sub

  9. #19
    thoroti Guest
    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!!!!!!

  10. #20
    phonghan Guest
    Trích dẫn Gửi bởi Rùa Con 1080
    Thế còn chỉ cần xóa những cell trùng trong cột A thôi, mong Anh giúp.
    Tô thế nào thì xóa thế ấy, bạn tự nghiên cứu vậy, trong code có sẳn rồi.

Trang 2 của 3 Đầu tiênĐầu tiên 123 CuốiCuối

Quyền viết bài

  • Bạn Không thể gửi Chủ đề mới
  • Bạn Không thể Gửi trả lời
  • Bạn Không thể Gửi file đính kèm
  • Bạn Không thể Sửa bài viết của mình
  •