ايجاد طريقة لجلب بيانات في حالة التكرار لنفس التاريخ

[محمد لؤي]

السلام عليكم -

عندي ملف ارجو من حضراتكم الاطلاع عليه - ومساعدتي

وان شاء الله قدرت اوصل الفكرة

 

 

 

استفسار.rar

استفسار1.xlsm

تم تعديل سبتمبر 15, 2019 بواسطه محمد لؤي

[سليم حاصبيا]

تفضل الكود اولاً

Option Explicit
Sub find_Please()
If ActiveSheet.Name <> "بنزين" Then Exit Sub
Dim B As Worksheet: Set B = Sheets("بنزين")
Dim M As Worksheet: Set M = Sheets("الموقف1")
Dim r%, k%
Dim M_R As Range
Dim dic As Object
Set M_R = M.Range("A2", M.Cells(Rows.Count, 1).End(3)).Resize(, 6)
Set dic = CreateObject("Scripting.Dictionary")
Dim My_word: My_word = B.Range("O1")
Dim x%: x = M_R.Rows.Count: Dim i%
Dim arr(1 To 4)
arr(1) = "B": arr(2) = "F": arr(3) = "G": arr(4) = "H"
B.Range("b2").Resize(1000, 8).ClearContents

For i = 1 To x
  dic(M_R.Cells(i, 5).Value) = ""
Next
 With B.Range("O1").Validation
  .Delete
  .Add xlValidateList, Formula1:=Join((dic.keys), ",")
 End With
 
r = 2
For i = 1 To x
If r - 1 > Application.CountIf(M_R, My_word) Then Exit For
 If M_R.Cells(i, 5) = My_word Then
     B.Cells(r, arr(1)) = M_R.Cells(i, 5)
     B.Cells(r, arr(2)) = M_R.Cells(i, 1)
     B.Cells(r, arr(3)) = M_R.Cells(i, 2)
     B.Cells(r, arr(4)) = M_R.Cells(i, 6)
 r = r + 1
End If
Next
Erase arr: dic.RemoveAll: Set M_R = Nothing: Set dic = Nothing
Set M = Nothing: Set B = Nothing
End Sub

ثم الملف ثانياً   (اختيار الاسم من القائمة المنسدلة المطاطة (لعدم الوقوع في خطأ الكتابة مسافة زائدة /مسافة ناقصة /خطأ املائي /أخطاء الهمزة / الخ... و لتوفير الوقت)

 

استفسار .xlsm

[محمد لؤي]

جزيت خيرا استاذي المحترم - اعزك الله

طلبي ليس هذا

موضوعي هو : تأتني مستندات صرف - وقبل ما تأتني المستندات يأتي الموقف كل يوم - اقوم بادخال الموقف - وبعدها تأتيني مستندات الصرف

اقوم بادخال المستندات - 

فطلبي هو - عند القيام بادخال مستندات الصرف وعند كتابة اسم المحطة وتاريخ التحميل - اريد تأتيي تلقائيا باقي البيانات المتوفرة بالموقف

المشكلة التي واجهتني - في حالة وجود تكرار لنفس المحطة وتاريخ التحميل لا تأتيني البيانات - اريد حل هذه المشكلة 

تسلم واسف اخذت من وقتك وجهدك - جزاك الله عنا خير

تم تعديل سبتمبر 15, 2019 بواسطه محمد لؤي