رسالة عند وجود اكثر من سجل

**ماجدجلال** · يناير 3, 2020

السلام عليكم ورحمة الله وبركاتة

في المرفق ملف وله نموذج لادخال البيانات , من الطبيعي ان يتكرر السجل اكثر من مرة بسبب وجود اكثر من قضية علي نفس الرقم و التاريخ , و لكن المطلوب من الكود اظهار عدد مرات تكرر هذا السجل ,,

في الملف المرفق شرح اكثر ,

ارجو منكم المساعدة ولكم جزيل الشكر

5487.xlsm

**سليم حاصبيا** · يناير 3, 2020

لا لزوم للكود ولا لليوزر في هذه الحالة

شاهد هذا الملف

COND_FORMAT.xlsm

**ماجدجلال** · يناير 4, 2020

السلام عليكم ورحمة الله وبركاتة

شكرا لك استاذ : سليم

الفكرة ممتازة جدا

و لكن الملف الذي لدي لا يعتمد علي نسخ و لصق المعادلات او التنسيق الشريطي , لان صاحب الملف لايرغب في وجود معادلات تحتاج الي نسخ ولصق , لانها تحتاج الي متابعه اذا ما وصل الي خلايا لا يوجد بها معادلات و هذا يسبب له ارتباك في العمل , وخوفا ان يكون قد وصل الي خلايا فارغة لا يوجد بها معادلات او تنسيق شريطي ,

استاذ سيلم : ساحاول ان انقل المعادلات الي النموذج , ففكرتها ممتاز وان شاء الله تنجح

ولا استغني عن دعمكم

الله يسعدك ويوفقك

**سليم حاصبيا** · يناير 4, 2020

يمكنك نسخ المعادلات الى اخر صف في العامود (اكثر من مليون صف في كل عامود من اكسل فهل تحتاج الى اكثر )بالاضافة الى ان المعادلات محمية ضد الكتابة فوقها (بمعنى لو بالخطأ حددت احد الخلايا التي تحتوي على معادلة وحاولت كتابة اي شيء فيها فان اكسل لا يسمح بذلك)

**ماجدجلال** · يناير 5, 2020

السلام عليكم ورحمة الله وبركاتة ,,,

البارح و الحمد لله , استطعت ادخال الدالة sumproduct في كود و كانت تعطي نتائج صحيحة ,

حاولت جعل النطاق دينميكي و ولكن فشلت , ايض وجهتني مشكلة التعامل مع التاريخ ,, حيث ان الكود يعمل بشكل صحيح مع الارقام فقط

ارجو منكم المساعدة و شكرا لكم ,,,,

5487.xlsm

**سليم حاصبيا** · يناير 5, 2020

يلزم هذين الكودين من اجل اليوزر (يمكنك العمل على الشيت حتى ولو كان اليوزر ظاهراً)

بعد الضغط على الزر اضافة السجل

1- تنقل كل البينات الى مواقعها

2 - يتم تلوين المكرر

3- تمسح البيانات من اليوزر بانتظار البيانات الجديدة

Private Sub CommandButton1_Click()
Dim Final_row As Long, k%
 Final_row = cells(rows.Count, 1).End(3).row + 1
 For k = 1 To 5
  cells(Final_row, 1).Offset(, k - 1) = Me.Controls("TextBox" & k)
  
  Next
 colorize_me
 For k = 1 To 5
   Me.Controls("TextBox" & k) = vbNullString
  Next
End Sub
'++++++++++++++++++++++++++++++++++++++

Sub colorize_me()

Dim laste_row As Long, I As Long
laste_row = cells(rows.Count, 1).End(3).row
Range("A8").Resize(laste_row - 7, 5).Interior.ColorIndex = xlNon

myvalu = "=SUMPRODUCT(--(A8" & "&" & """*""" & "&" & _
"B8=$A$8:A" & TextBox1 & "&" & """*""" & "&" & "B$8:B" & TextBox1 & "))"
Range("MM8").Resize(laste_row - 7).Formula = myvalu
    
    For I = 8 To laste_row
      If Range("MM" & I) > 1 Then _
      Range("A" & I).Resize(, 5).Interior.ColorIndex = 6
    Next
    
Range("MM8").Resize(laste_row - 7).Clear
End Sub

الملف مرفق

SALIM_code.xlsm

**ماجدجلال** · يناير 5, 2020

الف الف شكرا لك استاذ سليم

بارك الله فيك

ربنا يوفقك ويسعدك

الف الف شكرا

**ماجدجلال** · يناير 6, 2020

السلام عليكم ورحمة الله وبركاتة

احب ان اشكر الاستاذ سليم , علي مساعدته لي و حسن اخلاقة في تحملي

البارحة حاولت و حسب طلب المستخدم , ان اضيف رسالة تنبيه تقوم بحساب عدد السجلات السابقة ( الموجودة في الجدول سابقا ) مقارنتا بالسجل الجديد الذي قام المستخدم حاليا باضافته ( اذا كان مكرر - موجود سابقا ) للتوضيح : لنفترض ان السجل ( رقم الوارد ( 8 ) و بتاريخ ( 1440/01/01) موجود سابقا في الجدول و مكرر 3 مرات

1- المستخدم لا يدري ان السجل الذي يريد اضافتة الان هو موجودا سابقا و مكرر ( 3) مرات .

2- بعد فتح اليوزو وكتابة الرقم 8 كرقم وارد جديد وتاريخ 1440/01/01 , و النقر علي زر ( اضافة السجل ) .

3-يقوم الاكسيل باضهار msgbox بان السجل الموجود حاليا في اليوزو هو موجود مسبقا في الجدول و مكرر 3 مرات

والله حاولت الاعتماد علي نفسي و لكني فشلت , ان علم الاكود بحر واسع و لعل اسهل شي فية هو اصعب شي الا وهو النقاط و الاقواس و علامات التنصيص

فارجو المساعدة ولكم جظيل الشكر و الامتنان ,,,

SALIM_code.xlsm

**سليم حاصبيا** · يناير 6, 2020

تم التعديل على الماكرو

Private Sub CommandButton1_Click()
Dim Final_row As Long, k%
 Final_row = Cells(Rows.Count, 1).End(3).row + 1
 
 For k = 1 To 5
  Cells(Final_row, 1).Offset(, k - 1) = Me.Controls("TextBox" & k)
  Next
   On Error GoTo EXIT_ME
  Cells(Final_row, 1) = CInt(Cells(Final_row, 1))
  colorize_me
 For k = 1 To 5
   Me.Controls("TextBox" & k) = vbNullString
 Next
  Exit Sub
EXIT_ME:
 MsgBox "YOU MUST ENTER A NUMBER>0"
 Cells(Final_row, 1).Resize(, 5).ClearContents
  For k = 1 To 5
   Me.Controls("TextBox" & k) = vbNullString
  Next
End Sub
'++++++++++++++++++++++++++++++++++++++

Sub colorize_me()

Dim laste_row As Long, I As Long
laste_row = Cells(Rows.Count, 1).End(3).row
Range("A8").Resize(laste_row - 7, 5).Interior.ColorIndex = xlNon

myvalu = "=SUMPRODUCT(--(A8" & "&" & """*""" & "&" & _
"B8=$A$8:A" & 8 & "&" & """*""" & "&" & "B$8:B" & 8 & "))"
Range("MM8").Resize(laste_row - 7).Formula = myvalu
    
    For I = 8 To laste_row
      If Range("MM" & I) > 1 Then
      Range("A" & I).Resize(, 5).Interior.ColorIndex = 6
      MsgBox "Duplicate: " & Chr(10) & Range("MM" & I) - 1 & IIf(Range("MM" & I) = 2, "Time", "Times")
     End If
    Next

Range("MM8").Resize(laste_row - 7).Clear

End Sub

الملف من جديد

SALIM_code_UPDATED.xlsm

**سليم حاصبيا** · يناير 6, 2020

مع اني افضل هذا الكود

لأنه لا ضرورة للضغط على OK في كل مرة تظهر رسالة التنبيه

Private Sub CommandButton1_Click()
Dim Final_row As Long, k%
 Final_row = Cells(Rows.Count, 1).End(3).row + 1
 
 For k = 1 To 5
  Cells(Final_row, 1).Offset(, k - 1) = Me.Controls("TextBox" & k)
  Next
   On Error GoTo EXIT_ME
  Cells(Final_row, 1) = CInt(Cells(Final_row, 1))
  colorize_me
 For k = 1 To 5
   Me.Controls("TextBox" & k) = vbNullString
 Next
  Exit Sub
EXIT_ME:
 MsgBox "YOU MUST ENTER A NUMBER>0"
 Cells(Final_row, 1).Resize(, 5).ClearContents
  For k = 1 To 5
   Me.Controls("TextBox" & k) = vbNullString
  Next
End Sub
'++++++++++++++++++++++++++++++++++++++

Sub colorize_me()

Dim laste_row As Long, I As Long
laste_row = Cells(Rows.Count, 1).End(3).row
Range("A8").Resize(laste_row - 7, 7).Interior.ColorIndex = xlNon

myvalu = "=SUMPRODUCT(--(A8" & "&" & """*""" & "&" & _
"B8=$A$8:A" & 8 & "&" & """*""" & "&" & "B$8:B" & 8 & "))"
Range("MM8").Resize(laste_row - 7).Formula = myvalu

  Range("g8").Resize(laste_row - 7).ClearContents
    For I = 8 To laste_row
      If Range("MM" & I) > 1 Then
      Range("A" & I).Resize(, 5).Interior.ColorIndex = 6
     Range("A" & I).Offset(, 6) = "Duplicate: " & _
     Range("MM" & I) - 1 & IIf(Range("MM" & I) = 2, "Time", "Times")
     Range("A" & I).Offset(, 6).Interior.ColorIndex = 3
     End If
    Next

Range("MM8").Resize(laste_row - 7).Clear

End Sub

الملف

SALIM_code_UPDATED(1).xlsm

**ماجدجلال** · يناير 6, 2020

السلام عليكم ورحمة الله وبركاتة

ماشاء الله تبارك الله

ممتاز جدا ممتاز

قمت بتعديل بسيط جدا علي الكود ليكون

Dim laste_row As Long, I As Long, non As Long
laste_row = Cells(Rows.Count, 1).End(3).row
Range("A8").Resize(laste_row - 7, 5).Interior.ColorIndex = xlNon

myvalu = "=SUMPRODUCT(--(A8" & "&" & """*""" & "&" & _
"B8=$A$8:A" & 8 & "&" & """*""" & "&" & "B$8:B" & 8 & "))"
Range("MM8").Resize(laste_row - 7).Formula = myvalu
    
    For I = 8 To laste_row
      If Range("MM" & I) > 1 Then
      'Range("A" & I).Resize(, 5).Interior.ColorIndex = 6
      'MsgBox "Duplicate: " & Chr(10) & Range("MM" & I) - 1 & IIf(Range("MM" & I) = 2, "Time", "Times")
     non = non + 1
     End If
    Next
MsgBox non
Range("MM8").Resize(laste_row - 7).Clear

تم اضافة متغير non يحسب اجمالي عدد السجلات المطابقة للسجل الموجود في اليوزر , ويتم اظهاره مرة واحدة فقط ,

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

**سليم حاصبيا** · يناير 6, 2020

انت بهذه الطريفة تطهر رسالة بعدد التكرارات لجميع السجلات و ليس لكل سجل وحده اذا تكرر

جرب ان تكرر سجلين مختلفين و ترى النتيجة و تعرف ما اقصد به

الافضل ان تجرب الماكرو الموجود في اخر مشاركة قدمتها لك

**ماجدجلال** · يناير 7, 2020

فعلا ,,, الان تاكدت كلامك صحيح

شكرا لك علي التنبيه

باخذ الملف الاخيرة الذي ارفقته

شكرا لك

السلام عليكم ورحمة الله وبركاتة ,,

احب اشكر الاستاذ سليم علي دعمة الغير محدود و مساعدته لي ,, فله الشكر و التقدير ,

الحمد لله , كذا تم حل المشكلة و الانتهاء من الملف المطلوب , و لكن من باب التعليم و الفائدة , لدي سؤال و متعبني ,

كيف يمكن دمج قيمة ثابتة و قيمة متغيرة مع دالة داخل vba

هذة الكود

myvalu = "=SUMPRODUCT(--(O6:O" & LR = Textbox1 &")*(P6:P" & LR & = Textbox2 & "))"

باعتبار ان LR متغير يرمز الي اخر سطر فية بيانات

Textbox 1 and Textbox 2 هما مربع نص في اليوزو

فكيف يتم ذلك . وكما ذكرت هذا من باب التعليم , لان عجزت اعملها و افهمها ,

**سليم حاصبيا** · يناير 7, 2020

جرب هذا الكود

Option Explicit
Sub TEST()
Dim myvalu$, lr%, x1$, x2$

x1 = """" & Me.TextBox1 & """": x2 = """" & Me.TextBox2 & """"
lr = Cells(Rows.Count, 1).End(3).Row

myvalu = "=SUMPRODUCT((O6:O" & lr & "=" & x1 & ")*(P6:P" & lr & "=" & x2 & "))"
       'for hide the formula
 Cells(1, "N") = Evaluate(myvalu)
       'Or for show the formula
 Cells(2, "N").Formula = myvalu
End Sub

**ماجدجلال** · يناير 8, 2020

ماشاء الله تبارك الله

ممتاز جدا

معليش تاخرت في الرد كنت اجرب الكود , وذهلت منه ,, باقي شي بسيط

اذا اردنا ان يكون textbox1 ان تعامل مع ارقام و textbox2 تعامل مع تاريخ , يتغير الكود ؟؟؟؟؟

لاني لاحظت انه اذا كان داخلهما نصوص يعطي نتائج صحيحة 100% واذا كان غير ذلك يعطي صفر

بصراحة شي رائع , بارك الله فيك استاذنا الغالي

تسجيل الدخول

رسالة عند وجود اكثر من سجل

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

ماجدجلال

سليم حاصبيا

ماجدجلال

سليم حاصبيا

ماجدجلال

سليم حاصبيا

ماجدجلال

ماجدجلال

سليم حاصبيا

سليم حاصبيا

ماجدجلال

سليم حاصبيا

ماجدجلال

سليم حاصبيا

ماجدجلال

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information