làm sao cảnh báo khi trùng số liệu của 2 cột (2 người xem)

[duongkhanhphuc]

em có 2 cột:
- cột A : tờ bản đồ số
- cột B: thửa đất số
điều kiện: trên 1 tờ bản đồ, số thửa là duy nhất.
ví dụ: tờ bản đồ 1, thửa 1
tờ bản đồ 1, thửa 2
tờ bản đồ 2, thửa 2
============
khi nhập tờ bản đồ 1, thửa 1 lân thứ 2 sẽ báo lỗi, hoặc cảnh báo cho biết đã có dữ liệu
nếu nhập tờ bản đồ 2 thửa 1 thì vẫn đúng.
áp dụng để lập dữ liệu cho ng đăng ký sử dụng đất, trên 1 thửa đất của 1 tờ bản đồ chỉ có 1 chủ. 2 tờ bản đồ khác nhau thửa số có thể trùng.

 

[cop_kh]

em có 2 cột:
- cột A : tờ bản đồ số
- cột B: thửa đất số
điều kiện: trên 1 tờ bản đồ, số thửa là duy nhất.
ví dụ: tờ bản đồ 1, thửa 1
tờ bản đồ 1, thửa 2
tờ bản đồ 2, thửa 2
============
khi nhập tờ bản đồ 1, thửa 1 lân thứ 2 sẽ báo lỗi, hoặc cảnh báo cho biết đã có dữ liệu
nếu nhập tờ bản đồ 2 thửa 1 thì vẫn đúng.
áp dụng để lập dữ liệu cho ng đăng ký sử dụng đất, trên 1 thửa đất của 1 tờ bản đồ chỉ có 1 chủ. 2 tờ bản đồ khác nhau thửa số có thể trùng.

Bạn có thể đưa một số dữ liệu mẫu lên, chứ mô tả thế này làm dễ sai yêu cầu lắm bạn à.

 

[duongdv]

Đọc xong bài của bạn cứ thấy người "lâng lâng" như người bị say ấy. Cụ thể hóa yêu cầu bằng file minh họa đị bạn ơi!

 

[Hai Lúa Miền Tây]

em có 2 cột:
- cột A : tờ bản đồ số
- cột B: thửa đất số
điều kiện: trên 1 tờ bản đồ, số thửa là duy nhất.
ví dụ: tờ bản đồ 1, thửa 1
tờ bản đồ 1, thửa 2
tờ bản đồ 2, thửa 2
============
khi nhập tờ bản đồ 1, thửa 1 lân thứ 2 sẽ báo lỗi, hoặc cảnh báo cho biết đã có dữ liệu
nếu nhập tờ bản đồ 2 thửa 1 thì vẫn đúng.
áp dụng để lập dữ liệu cho ng đăng ký sử dụng đất, trên 1 thửa đất của 1 tờ bản đồ chỉ có 1 chủ. 2 tờ bản đồ khác nhau thửa số có thể trùng.

Bạn dùng code sau:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LLoop As Integer
    Dim LTestLoop As Integer
    Dim Lrows As Integer
    Dim LRange As String
    Dim LCnt As Integer
    Dim LColA_1, LColB_1 As String
    Dim LColA_2, LColB_2 As String
    Lrows = 2000
    LLoop = 2
    LCnt = 0
    While LLoop <= Lrows
        LColA_1 = "A" & CStr(LLoop)
        LColB_1 = "B" & CStr(LLoop)
       
        If Len(Range(LColA_1).Value) > 0 Then
            LTestLoop = LLoop + 1
            While LTestLoop <= Lrows
                If LLoop <> LTestLoop Then
                    LColA_2 = "A" & CStr(LTestLoop)
                    LColB_2 = "B" & CStr(LTestLoop)
                    If (Range(LColA_1).Value = Range(LColA_2).Value) _
                     And (Range(LColB_1).Value = Range(LColB_2).Value) Then
                        MsgBox "Da trung du lieu, vui long nhap lai", vbCritical, "Loi trung du lieu"
                        Rows(CStr(LTestLoop) & ":" & CStr(LTestLoop)).Select
                        Selection.Delete Shift:=xlUp
                        LTestLoop = LTestLoop - 1
                        LCnt = LCnt + 1
                    End If
                End If
                LTestLoop = LTestLoop + 1
            Wend
        End If
        LLoop = LLoop + 1
    Wend
End Sub

Nếu bạn nhập trùng thì nó sẽ tự động xóa dòng trùng và yêu cầu bạn nhập lại.

Bạn tham khảo thêm file nhé.

 

[duongkhanhphuc]

Bạn dùng code sau:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LLoop As Integer
    Dim LTestLoop As Integer
    Dim Lrows As Integer
    Dim LRange As String
    Dim LCnt As Integer
    Dim LColA_1, LColB_1 As String
    Dim LColA_2, LColB_2 As String
    Lrows = 2000
    LLoop = 2
    LCnt = 0
    While LLoop <= Lrows
        LColA_1 = "A" & CStr(LLoop)
        LColB_1 = "B" & CStr(LLoop)
       
        If Len(Range(LColA_1).Value) > 0 Then
            LTestLoop = LLoop + 1
            While LTestLoop <= Lrows
                If LLoop <> LTestLoop Then
                    LColA_2 = "A" & CStr(LTestLoop)
                    LColB_2 = "B" & CStr(LTestLoop)
                    If (Range(LColA_1).Value = Range(LColA_2).Value) _
                     And (Range(LColB_1).Value = Range(LColB_2).Value) Then
                        MsgBox "Da trung du lieu, vui long nhap lai", vbCritical, "Loi trung du lieu"
                        Rows(CStr(LTestLoop) & ":" & CStr(LTestLoop)).Select
                        Selection.Delete Shift:=xlUp
                        LTestLoop = LTestLoop - 1
                        LCnt = LCnt + 1
                    End If
                End If
                LTestLoop = LTestLoop + 1
            Wend
        End If
        LLoop = LLoop + 1
    Wend
End Sub

Nếu bạn nhập trùng thì nó sẽ tự động xóa dòng trùng và yêu cầu bạn nhập lại.

Bạn tham khảo thêm file nhé.

thx bác. em chưa biết dùng code của bác cho vào đâu. vì em không học tin văn phòng, những kiến thức về tin văn phòng do em tự học qua thực tế công việc, vò thế không có 1 hệ thống nào cả.
file gửi kèm có các sheet là các thôn của 1 xã.
- thửa đất trên cùng 1 tờ bản đồ là số duy nhất, trong tất cả các sheet
-dùng lệnh SORT sắp xếp theo vần abc thì chưa chuẩn lắm theo tiếng việt, nhưng số thửa sẽ được xếp theo chiều tăng, tờ bản đồ cũng vậy. dùng phần mềm SortTcvn của bác phạm văn trung thì chỉ xếp theo đc 2 cột là tối đa. làm sao để xếp theo chiều tăng của tên - họ + tờ bản đồ + số thửa.
thx tất cả. chỉ rõ cho em paste code vào chỗ nào nha.

 

[duongkhanhphuc]

code của bác domfootwear hem có chạy rùi

 

[Hai Lúa Miền Tây]

code của bác domfootwear hem có chạy rùi

Cho mình hỏi bản có Enable macro chưa vậy ?

 

[duongkhanhphuc]

tại hạ ngu muội quá, ko biết chỗ nào đễ kích hoạt macro nữa.
bác xem hộ em cái bảng em post trên kia rùi nghiên cứu coi : kiểm tra dữ liệu trùng nhau đồng thời số thửa và số tờ bản đồ trong tất cả các sheet đc ko. nếu trùng đưa ra thông báo. nếu không kiểm tra đc đồng thời trong tất cả các sheet thì kiểm tra từng sheet vậy.
việc phân thửa do máy tính làm, nhưng ko biết mấy tay địa chính làm ăn kiểu gì mà cả mấy thôn có trùng nhau về thửa trên cùng tờ bản đồ. tức là 1 mảnh đất mà có tới 2 thằng làm chủ đó.