منع تكرار البيانات

[El_Desouky]

السلام عليكم

عندى ملف اكسيل مكون من شيت واجهة ادخال بيانات وشيت اخر به جدول تسجل فيه البيانات الغرض من هذا الملف تسجيل تقرير يومى ويتم الحفظ من خلال الضغط على زر الحفظ فى واجهة الادخال.

اريد كود لمنع حفظ البيانات اذا كان التاريخ المسجل فى فورم ادخال البيانات محفوظ مسبقا فى جدول البيانات بالشيت الاخر

 

[abouelhassan]

جرب

Private Sub SaveButton_Click()
    Dim wsInput As Worksheet
    Dim wsData As Worksheet
    Dim inputDate As Date
    Dim lastRow As Long
    Dim checkDate As Range

    Set wsInput = ThisWorkbook.Sheets("واجهة الادخال")
    Set wsData = ThisWorkbook.Sheets("جدول البيانات")

    'Get the date from the input form
    inputDate = wsInput.Range("A2").Value

    'Check if the date is already in the data table
    With wsData
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set checkDate = .Range("A2:A" & lastRow).Find(inputDate, LookIn:=xlValues, lookat:=xlWhole)
    End With

    'If the date is found, prevent saving and show a message
    If Not checkDate Is Nothing Then
        MsgBox "تم حفظ تقرير لهذا التاريخ مسبقاً"
        Exit Sub
    End If

    'Save the data if the date is not found
    'Add your code here to save the data to the data table

End Sub

 

[El_Desouky]

السلام عليكم 

استاذ ابو الحسن

جربت الاكواد ولم تقم بالمطلوب سوف اشرح لك الملف بشكل اوضح

اريد مقارنه الخليه f13 داخل شيت home بالعمود j داخل الشيت daily وهما عبارة عند تاريخ ف اذا كان التاريخ بالخليه f13 مسجل مسبقا داخل العامود j يمنع التسجيل ويظهر لى رساله بذلك

 

[abouelhassan]

جرب

Private Sub SaveButton_Click()
    Dim wsHome As Worksheet
    Dim wsDaily As Worksheet
    Dim inputDate As Date
    Dim checkDate As Range

    Set wsHome = ThisWorkbook.Sheets("Home")
    Set wsDaily = ThisWorkbook.Sheets("Daily")

    'Get the date from cell F13 in the Home sheet
    inputDate = wsHome.Range("F13").Value

    'Check if the date is already in column J in the Daily sheet
    With wsDaily
        Set checkDate = .Columns("J").Find(inputDate, LookIn:=xlValues, lookat:=xlWhole)
    End With

    'If the date is found, prevent saving and show a message
    If Not checkDate Is Nothing Then
        MsgBox "تم حفظ تقرير لهذا التاريخ مسبقاً في الجدول اليومي"
        Exit Sub
    End If

    'Save the data if the date is not found
    'Add your code here to save the data to the Daily sheet

End Sub

 

تأكد من تغيير اسماء الشيتات ("Home" و "Daily") وتعديل موضع الخطأ في حالة وجود أي اختلاف في اسماء الشيتات.

[El_Desouky]

السلام عليكم 

استاذ ابو الحسن

الكود لا يعمل ايضا ارفقت لك الملف كامل 

 

 

تقرير بورتوفيق.xlsm

[محمد هشام.]

 

Private Sub CommandButton4_Click()
Dim WS As Worksheet: Set WS = Sheets("Home")
Dim dest As Worksheet: Set dest = Sheets("Daily")
Dim search As Range, Rng As Range
Set search = WS.[F13]: Set Rng = WS.[F4:F13]


If Application.WorksheetFunction.CountA(Rng) = 0 Or search = Empty Then
    MsgBox "المرجوا إدخال البيانات", vbExclamation, "Admin"
     Exit Sub
Else
If Application.WorksheetFunction.CountIf(dest.Range("j:j"), search) > 0 Then MsgBox " تم حفظ هذا اليوم مسبقا" & "  " & search, vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal, "انتباه": Exit Sub
a = Array([F4], [F5], [F6], [F7], [F8], [F9], [F10], [F11], [F12], [F13])
  dest.[a65000].End(xlUp).Offset(1).Resize(, 10) = a
   dest.Range("j4:j" & Rows.Count).NumberFormat = "dd/mm/yyyy"
     Rng.ClearContents
  
 MsgBox "تم حفظ البيانات بنجاح" & "  " & search & "  " & "بنجاح", _
 vbInformation, "Done"
 End If
End Sub

 

 

تقرير بورتوفيق.xlsm

[El_Desouky]

شكرا جدا لمجهودك استاذ محمد الملف يعمل بشكل ممتاز