Xin hỏi về cảnh báo trùng giửa 2 cột. (1 người xem)

thanhtam348 · 3/5/12

Anh chị và các bạn cho hỏi: có code nào để cảnh báo cho mình việc trùng giửa 2 cột không?
DV cột A là ngày tháng năm, cột B là mã hàng và cảnh báo cho mình rằng "ngày tháng ...đã nhập mã nầy rồi".
Nếu được xin giúp đở.

Ba Tê · 3/5/12

thanhtam348 đã viết:
Anh chị và các bạn cho hỏi: có code nào để cảnh báo cho mình việc trùng giửa 2 cột không?
DV cột A là ngày tháng năm, cột B là mã hàng và cảnh báo cho mình rằng "ngày tháng ...đã nhập mã nầy rồi".
Nếu được xin giúp đở.

Tôi nghĩ là được nếu thấy "mặt mũi" nó ra sao.

Hoàng Trọng Nghĩa · 3/5/12

Đặt ngày tháng tại cột A và mã số tại cột B, thì code sẽ viết như sau:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range, MyRng As Range, ID As String
    If Target.Column = 2 Then
        ID = UCase(Target.Value)
        Set Rng = Range([B1], [B65536].End(xlUp))
        If ID = "" Or WorksheetFunction.CountIf(Rng, ID) <= 1 Then GoTo ExitSub
        Set MyRng = Rng.Find(ID, LookIn:=xlValues, LookAt:=xlWhole)
        If Not MyRng Is Nothing Then
            MyRng.Offset(, -1).Resize(, 2).Select
            MsgBox "Ma so nay: [ " & ID & " ] da ton tai vao ngay: " & MyRng.Offset(, -1).Text
            Target.Select
        End If
    End If
ExitSub:
    Set Rng = Nothing: Set MyRng = Nothing
End Sub

Ba Tê đã viết:
Tôi nghĩ là được nếu thấy "mặt mũi" nó ra sao.

Dạo này bác Ba Tê chắc muốn lên Bốn Tê hay sao mà tung hoành dọc ngang dữ hen! Phải công nhận Bác Ba Tê quá tiến bộ luôn!

Ba Tê · 3/5/12

Hoàng Trọng Nghĩa đã viết:
Đặt ngày tháng tại cột A và mã số tại cột B, thì code sẽ viết như sau:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range, MyRng As Range, ID As String If Target.Column = 2 Then Set Rng = Range([B1], [B65536].End(xlUp)) ID = UCase(Target.Value) If WorksheetFunction.CountIf(Rng, ID) <= 1 Or Target.Value = "" Then Exit Sub Set MyRng = Rng.Find(ID, LookIn:=xlValues, LookAt:=xlWhole) If Not MyRng Is Nothing Then MyRng.Offset(, -1).Resize(, 2).Select MsgBox "Ma so nay: [ " & ID & " ] da ton tai vao ngay: " & MyRng.Offset(, -1).Text Target.Select End If End If Set Rng = Nothing: Set MyRng = Nothing End Sub

Dạo này bác Ba Tê chắc muốn lên Bốn Tê hay sao mà tung hoành dọc ngang dữ hen! Phải công nhận Bác Ba Tê quá tiến bộ luôn!

Quả là HTN siêng thật.
Mình đọc không hiểu tác giả muốn gì.
Ví dụ ngày 1/5/2012 nhập mã hàng A, bên trên đã có ngày 1/5/2012 nhập mã hàng A rồi thì mới báo lỗi.
Làm như "Bồ" thì suốt năm 1 mã hàng chỉ nhập 1 lần thôi sao?
Híc, Híc! Hổng biết sao nữa.

Hoàng Trọng Nghĩa · 3/5/12

Ba Tê đã viết:
Quả là HTN siêng thật.
Mình đọc không hiểu tác giả muốn gì.
Ví dụ ngày 1/5/2012 nhập mã hàng A, bên trên đã có ngày 1/5/2012 nhập mã hàng A rồi thì mới báo lỗi.
Làm như "Bồ" thì suốt năm 1 mà hàng chỉ nhập 1 lần thôi sao?
Híc, Híc! Hổng biết sao nữa.

Muốn nhập mã ở ngày nào mà chẳng được Bác? Chỉ vì nếu thấy MÃ BỊ TRÙNG thì nó chỉ đến hàng đó và mã đó tại ngày nào đã nhập thôi, chứ mắc mớ gì đến cái ngày đâu???

LƯU Ý, bài dưới đã sửa code cho nhanh hơn tí ti, xem lại!

thanhtam348 · 3/5/12

Cám ơn hai anh bạn.
"Mặt mũi" nó nè! - nhờ hai anh giúp hộ.

Hoàng Trọng Nghĩa · 3/5/12

thanhtam348 đã viết:
Cám ơn hai anh bạn.
"Mặt mũi" nó nè! - nhờ hai anh giúp hộ.

Thế bạn muốn nhập nó trên form à? Nhập trên form thì ngắn gọn hơn nữa!

thanhtam348 · 3/5/12

Cám ơn, nhờ giúp dùm mình đi!

Hoàng Trọng Nghĩa · 3/5/12

thanhtam348 đã viết:
Cám ơn, nhờ giúp dùm mình đi!

Vì tôi không có cái control DatePicker gì đó nên tôi thay thế bằng cái Calendar, code như sau:

PHP:

Private Sub CommandButton1_Click()
    Dim MyRng As Range, ID As String, i As Long
        ID = ListBox1.Value
        Set MyRng = Range(Sheet1.[B2], Sheet1.[B65536].End(xlUp)).Find(ID, LookIn:=xlValues, LookAt:=xlWhole)
        If Not MyRng Is Nothing Then
            MsgBox "Ma so nay: [ " & ID & " ] da ton tai vao ngay: " & MyRng.Offset(, -1).Text
        Else
            With Sheet1.[A65536].End(xlUp).Offset(1)
                .Value = Format(Calendar1.Value, "dd/mm/yyyy")
                .Offset(, 1) = ID
                .Offset(, 2) = ListBox1.Column(1)
            End With
        End If
    Set MyRng = Nothing
End Sub

Ba Tê · 3/5/12

Hoàng Trọng Nghĩa đã viết:
Muốn nhập mã ở ngày nào mà chẳng được Bác? Chỉ vì nếu thấy MÃ BỊ TRÙNG thì nó chỉ đến hàng đó và mã đó tại ngày nào đã nhập thôi, chứ mắc mớ gì đến cái ngày đâu???

LƯU Ý, bài dưới đã sửa code cho nhanh hơn tí ti, xem lại!

Tui thì hiểu là cùng ngày, cùng mã hàng mới cảnh báo, cùng mã hàng mà khác ngày thì không báo.
Híc! Tác giả "nín thinh".
Làm thẳng vào sheet luôn, Fom làm gì cho "lu bu" chứ.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dic As Object, Rng(), I As Long
If Not Intersect(Target, [B2:B1000]) Is Nothing Then
    Set Dic = CreateObject("Scripting.Dictionary")
        Dic.Add Target.Offset(, -1).Value & Target.Value, ""
        Rng = Sheet1.Range([A1], [A65000].End(xlUp)).Resize(, 2).Value
        For I = 1 To UBound(Rng, 1) - 1
            If Not Dic.exists(Rng(I, 1) & Rng(I, 2)) Then
                Dic.Add Rng(I, 1) & Rng(I, 2), ""
            Else
                Range(Cells(I, 1), Cells(I, 2)).Select
                MsgBox "Ma hang da nhap o dong thu " & I
            End If
        Next
End If
Set Dic = Nothing
End Sub

Hoàng Trọng Nghĩa · 3/5/12

Ba Tê đã viết:
Tui thì hiểu là cùng ngày, cùng mã hàng mới cảnh báo, cùng mã hàng mà khác ngày thì không báo.
Híc! Tác giả "nín thinh".
Làm thẳng vào sheet luôn, Fom làm gì cho "lu bu" chứ.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) Dim Dic As Object, Rng(), I As Long If Not Intersect(Target, [B2:B1000]) Is Nothing Then Set Dic = CreateObject("Scripting.Dictionary") Dic.Add Target.Offset(, -1).Value & Target.Value, "" Rng = Sheet1.Range([A1], [A65000].End(xlUp)).Resize(, 2).Value For I = 1 To UBound(Rng, 1) - 1 If Not Dic.exists(Rng(I, 1) & Rng(I, 2)) Then Dic.Add Rng(I, 1) & Rng(I, 2), "" Else Range(Cells(I, 1), Cells(I, 2)).Select MsgBox "Ma hang da nhap o dong thu " & I End If Next End If Set Dic = Nothing End Sub

Kakaka, Cái này còn tùy ở tác giả muốn gì, nhưng bài nhỏ như con thỏ đâu cần dùng CÁI DIC TO ĐÙNG đâu bác!

Ba Tê · 3/5/12

Hoàng Trọng Nghĩa đã viết:
Kakaka, Cái này còn tùy ở tác giả muốn gì, nhưng bài nhỏ như con thỏ đâu cần dùng CÁI DIC TO ĐÙNG đâu bác!

Tại mình đang "học lóm" cái "Đích Xông To Ri", gặp cái nào xài được là tập xài luôn cho quen tay.
Hì hì...
Mà hổng chắc nó sẽ nhỏ như con thỏ à nghe.

thanhtam348 · 3/5/12

Ba Tê đã viết:
Tui thì hiểu là cùng ngày, cùng mã hàng mới cảnh báo, cùng mã hàng mà khác ngày thì không báo.
Híc! Tác giả "nín thinh".
Làm thẳng vào sheet luôn, Fom làm gì cho "lu bu" chứ.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) Dim Dic As Object, Rng(), I As Long If Not Intersect(Target, [B2:B1000]) Is Nothing Then Set Dic = CreateObject("Scripting.Dictionary") Dic.Add Target.Offset(, -1).Value & Target.Value, "" Rng = Sheet1.Range([A1], [A65000].End(xlUp)).Resize(, 2).Value For I = 1 To UBound(Rng, 1) - 1 If Not Dic.exists(Rng(I, 1) & Rng(I, 2)) Then Dic.Add Rng(I, 1) & Rng(I, 2), "" Else Range(Cells(I, 1), Cells(I, 2)).Select MsgBox "Ma hang da nhap o dong thu " & I End If Next End If Set Dic = Nothing End Sub

Cám ơn anh Ba Tê, anh nghỉ đúng rồi ! - mình muốn là cùng ngày+cùng mã thì báo, mình cũng muốn dùng nó bằng Form cho tiện, cũng là để tránh nhập sai mã, nếu anh có giúp thì hãy lập nó trên Form cho mình. Cám ơn anh.

TO: Hoàng Trọng Nghĩa.
Cám ơn bạn giúp mình, mình đang gán code của bạn vào bảng tính riêng (file đưa lên chỉ là giả lập), nếu có gì thì xin tư vấn tiếp.

Ba Tê · 3/5/12

thanhtam348 đã viết:
Cám ơn anh Ba Tê, anh nghỉ đúng rồi ! - mình muốn là cùng ngày+cùng mã thì báo, mình cũng muốn dùng nó bằng Form cho tiện, cũng là để tránh nhập sai mã, nếu anh có giúp thì hãy lập nó trên Form cho mình. Cám ơn anh.

TO: Hoàng Trọng Nghĩa.
Cám ơn bạn giúp mình, mình đang gán code của bạn vào bảng tính riêng (file đưa lên chỉ là giả lập), nếu có gì thì xin tư vấn tiếp.

Cái Form thì tui "Yếu xìu", để Hoàng Trọng Nghĩa làm rồi tui học "ké" luôn.
Hì hì...

thanhtam348 · 3/5/12

Chưa hiệu quả các anh ơi! không thể nhập liệu được, mình cũng không có cái Calendar như Hoàng Trọng Nghĩa nhưng mở Form thì không thấy lổi. mình gởi tiếp File lên đây nhờ các anh và các bạn xem lại dùm.

Hoàng Trọng Nghĩa · 3/5/12

thanhtam348 đã viết:
Chưa hiệu quả các anh ơi! không thể nhập liệu được, mình cũng không có cái Calendar như Hoàng Trọng Nghĩa nhưng mở Form thì không thấy lổi. mình gởi tiếp File lên đây nhờ các anh và các bạn xem lại dùm.

Vẫn là cái Calendar tôi làm như sau:

PHP:

Private Sub CommandButton1_Click()
    Dim ID As String, i As Long, Ngay As Date
    Dim Trung As Boolean, MyArr
    Trung = False
    MyArr = Range(Sheet1.[A2], Sheet1.[B65536].End(xlUp)).Value
    ID = ListBox1.Value
    Ngay = TextBox1.Value
    For i = 1 To UBound(MyArr)
        If MyArr(i, 2) = ID And MyArr(i, 1) = Ngay Then
            MsgBox "Ma so nay: [ " & ID & " ] da ton tai vao ngay: " & Ngay
            Trung = True: Exit For
        End If
    Next
    If Trung Then Exit Sub
    With Sheet1.[A65536].End(xlUp).Offset(1)
        .Value = Ngay
        .Offset(, 1) = ID
        .Offset(, 2) = ListBox1.Column(1)
    End With
End Sub

Click vào cái Calendar để có ngày trong TextBox1 từ đó chọn vào trong ListBox mã nào đó và bấm nút chọn.

thanhtam348 · 3/5/12

Đã tốt rồi! - cám ơn bạn Hoàng Trọng Nghĩa .

Xin bạn cho hỏi thêm chút. nếu mình đặt thông báo trong vùng nầy [ " & ID & " ] thay bằng tên hàng thì phải làm sao?

Hoàng Trọng Nghĩa · 3/5/12

thanhtam348 đã viết:
Đã tốt rồi! - cám ơn bạn Hoàng Trọng Nghĩa .

Xin bạn cho hỏi thêm chút. nếu mình đặt thông báo trong vùng nầy [ " & ID & " ] thay bằng tên hàng thì phải làm sao?

Vì mặt hàng của bạn bằng tiếng Việt nên thông báo phải như sau:

PHP:

        If MyArr(i, 2) = ID And MyArr(i, 1) = Ngay Then
            Application.Assistant.DoAlert "THÔNG BÁO", _
                        Sheet2.[D2].Value & ListBox1.Column(1) & _
                        Sheet2.[D3].Value & Ngay, msoAlertButtonOK, _
                        msoAlertIconCritical, msoAlertDefaultFirst, _
                        msoAlertCancelDefault, False
            ''MsgBox "Ma so nay: [ " & ID & " ] da ton tai vao ngay: " & Ngay
            Trung = True: Exit For
        End If

Với MsgBox này sẽ hiển thị được tiếng Việt.

Góp ý thêm, trong thủ tục dưới đây có đoạn:

Mã:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
[COLOR=#ff0000][B] Application.Calculation = xlManual [/B][/COLOR]
 If CommandButton1.Enabled Then
    CommandButton1_Click
 End If
End Sub

Mỗi lần như vậy là nó cứ ra 1 lệnh tính thủ công, nhưng sau khi thoát form thì không có thủ tục tính toán tự động. Vậy để khắc phục tình trạng này và nhằm tăng tốc chương trình ta làm như sau:

Khởi động form ta đặt sự kiện này:

Mã:

Private Sub UserForm_Initialize()
[COLOR=#0000cd][B]    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With[/B][/COLOR]
    Calendar1.Value = Date
    TextBox1.Value = Format(Calendar1.Value, "dd/mm/yyyy")
End Sub

Và khi thoát Form ta đặt thêm sự kiện này:

Mã:

Private Sub UserForm_Terminate()
[B][COLOR=#0000cd]    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With[/COLOR][/B]
End Sub

Như vậy khi nhập liệu sẽ nhanh hơn và không bị chớp màn hình.

thanhtam348 · 3/5/12

Thành thật cám ơn bạn nha!

Xin hỏi về cảnh báo trùng giửa 2 cột. (1 người xem)

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

Thành viên thường trực

Cạo Rồi Khỏi Gội

Chuyên gia GPE

File đính kèm

Cạo Rồi Khỏi Gội

Chuyên gia GPE

Thành viên thường trực

File đính kèm

Chuyên gia GPE

Thành viên thường trực

Chuyên gia GPE

File đính kèm

Cạo Rồi Khỏi Gội

Chuyên gia GPE

Cạo Rồi Khỏi Gội

Thành viên thường trực

Cạo Rồi Khỏi Gội

Thành viên thường trực

File đính kèm

Chuyên gia GPE

File đính kèm

Thành viên thường trực

Chuyên gia GPE

File đính kèm

Thành viên thường trực

Đếm ngược thời gian