اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام وعليكم الاعضاء الكرام

اريد كود او اي طريقة لمنع تكرار البيانات المدخلة في العامود A 

لاكثر من شيت بحيث عند ادخال الخلية المكررة سواء في نفس الشيت او 

شيتات أخري يمنع الادخال او يعطي رسالة تحذيرية

تكرار البيانات في عامود.xlsx

  • أفضل إجابة
قام بنشر

جرب هذا الماكرو  ( اذا كان هناك تكرار  تصدر رسالة بمكان التكرار و يقوم الماكرو بمسح ما كتبته)

Option Explicit

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim x%, First As Range, y%, My_address$
Application.EnableEvents = False
 If Not Intersect(sh.Columns(1), Target) Is Nothing Then
        Set First = Cells(Target.Row, 1)
        y = Application.CountIf(ActiveSheet.Columns(1), First)
            If y > 1 Then
             MsgBox "Error!" & Chr(10) & "This Record is Allready Exits in" & Chr(10) & _
             ActiveSheet.Name
             Target = vbNullString
             GoTo Exit_me
            End If
      For Each sh In Sheets
          If sh.Name = ActiveSheet.Name Then GoTo My_next:
          x = Application.CountIf(sh.Columns(1), First)
          If x > 0 Then
          My_address = sh.Columns(1).Find(First, lookat:=1).Address
          MsgBox "Error!" & Chr(10) & "This Record Is Already Exits in" & Chr(10) & _
          sh.Name & ":" & My_address
          Target = vbNullString
          GoTo Exit_me
          End If
My_next:
      Next
 End If

Exit_me:
Application.EnableEvents = True
End Sub

الملف مرفق

No Repeat In All Sheets.xlsm

  • Like 1
  • Thanks 2
قام بنشر

عندها يجب استبدال الكود الى هذا

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim x%, First As Range, y%, My_address$, Answer As Byte
Application.EnableEvents = False
 If Not Intersect(sh.Columns(1), Target) Is Nothing Then
        Set First = Cells(Target.Row, 1)
        y = Application.CountIf(ActiveSheet.Columns(1), First)
            If y > 1 Then
        My_address = ActiveSheet.Columns(1).Find(First, lookat:=1).Address
 Answer = MsgBox("Error!" & Chr(10) & "This Record is Allready Exits in" & Chr(10) & _
          " This Sheet cell:" & My_address & Chr(10) & "do you want to continue", vbYesNo)
                If Answer <> 6 Then
                  Target = vbNullString
                  GoTo Exit_me
                 Else
                  GoTo Exit_me
                End If
            End If
      For Each sh In Sheets
          If sh.Name = ActiveSheet.Name Then GoTo My_next:
          x = Application.CountIf(sh.Columns(1), First)
          If x > 0 Then
          My_address = sh.Columns(1).Find(First, lookat:=1).Address
          Answer = MsgBox("Error!" & Chr(10) & "This Record is Allready Exits in" & _
          Chr(10) & sh.Name & ":" & My_address & Chr(10) & _
          "do you want to continue", vbYesNo)
           If Answer <> 6 Then
             Target = vbNullString
             GoTo Exit_me
            End If
          GoTo Exit_me
          End If
My_next:
      Next
 End If

Exit_me:
Application.EnableEvents = True
End Sub

الملف من جديد

 

No Repeat In All Sheets_by_choise.xlsm

  • Like 1
  • Thanks 2

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information