مهند محسن

هل هناك حل ؟ جزاكم الله كل خير

للرفع أكرمكم الله

أتمنى ان يكون هناك مساعدة وحل

اليس هناك حل ؟ بارك الله فيكم

للرفع بارك الله فيكم جميعا

بارك الله فيكم جميعا أساتذتى الكرام وجعله الله فى ميزان حسناتكم باختصار ان اريد ضبط الكود فكان فى البداية يعمل معى بكل كفاءة وهو من أعمال استاذى الكريم ابو نور -فكل ما اريده هو جلب كل التواريخ ببياناتها من صفحة Data ووضعها وترحيلها الى صفحة Excursion بنفس الشكل الذى تم رفعه سابقا وقد تم رفع نتائج يوم 01/03/2019 بالضبط كمثال لما هو مطلوب فأرجو جلب البيانات بهذه الطريقة فى كل الأيام بحيث تنطبق لما هو وارد بصفحة Data جعله الله فى ميزان حسناتكم وغفر الله لكم جميعا فكما ترى أساتذتى الكرام عند تنفيذ الكود تظهر هذه الرسالة وايضا ايظهر تكرار بيانات فى اليوم الواحد كما ترى حضرتك بالصورة

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

للرفع بارك الله فيكم جميعا

بارك الله فيكم جميعا ارجو المساعدة ولا لا يوجد حل ؟

يمكنك تجربة هذا الرابط لحل المشكلة ان شاء الله http://www.torkymax.com/2010/10/run-time-error-13-type-mismatch.html

بارك الله فيكم اتمنى المساعدة

جرب هذا هذه رسالة آلية يرجي اضافة الحل مباشرة فى الموقع و ليس وصلة خارجية بحسب قواعد المشاركة و لا مانع من ذكر اسم صاحب المشاركةforum/t937 وهذه دالة ايضا معرفة للأستاذ ياسر خليل ابو البراء لتحويل التاريخ من ميلادى الى هجرى http://yasserkhalilexcellover.blogspot.com/2016/05/gregorian-hijri-converter.html وهذا رابط داخل المنتدى ايضا https://www.officena.net/ib/topic/64350-تحويل-التاريخ-من-ميلادى-الى-هجرى-على-الفورم/ https://www.officena.net/ib/topic/81145-فورم-التقويم-الهجري-والتقويم-الميلادي-ومحوال-التاريخ/

ليس هناك حل لطلبك بهذه الطريقة

للرفع رفع الله قدركم

أتمنى ان يكون هناك حل بارك الله فيكم جميعا

هذا هو الكود المطلوب التعديل عليه Sub Unqu() Application.Calculation = xlCalculationManual lr = Range("a" & Rows.Count).End(xlUp).Row If lr < 4 Then lr = 4 'Range("a4:k" & lr).Cells.Interior.Color = xlNone Range("a4:k" & lr).ClearContents ReDim arr(1 To 1000, 1 To 11) v = 2 For d = 1 To 31 lr = Sheets("Data").Range("c" & Rows.Count).End(xlUp).Row For r = 2 To lr If Day(Sheets("Data").Range("c" & r)) = d Then arr(v, 1) = Sheets("Data").Range("c" & r) arr(v, 2) = Sheets("Data").Range("b" & r) arr(v, 3) = WorksheetFunction.SumIfs(Sheets("Data"). _ Range("d:d"), Sheets("Data").Range("c:c"), arr(v, 1), _ Sheets("Data").Range("b:b"), arr(v, 2)) arr(v, 4) = WorksheetFunction.SumIfs(Sheets("Data"). _ Range("e:e"), Sheets("Data").Range("c:c"), arr(v, 1), _ Sheets("Data").Range("b:b"), arr(v, 2)) a = WorksheetFunction.Weekday(arr(v, 1)) If (arr(v, 1) <> "" And arr(v, 2) = "Grand Aquarium" And a = 3) _ Or (arr(v, 1) <> "" And arr(v, 2) = "Grand Aquarium" And a = 7) Then arr(v, 5) = 40 arr(v, 6) = 20 Else 'arr(v, 5) = WorksheetFunction.VLookup(arr(v, 2), 'Sheets("Price").Range("a3:c216"), 2, 0) 'arr(v, 6) = WorksheetFunction.VLookup(arr(v, 2), _ 'Sheets("Price").Range("a3:c216"), 3, 0) End If b = WorksheetFunction.SumIfs(Sheets("Data").Range("j:j"), _ Sheets("Data").Range("c:c"), arr(v, 1), Sheets("Data"). _ Range("b:b"), arr(v, 2)) c = arr(v, 3) * arr(v, 5) f = arr(v, 4) * arr(v, 6) If c + f < b Then arr(v, 7) = b - (c + f) arr(v, 8) = c + f + arr(v, 7) Else arr(v, 8) = c + f End If t = t + arr(v, 8) If arr(v, 1) <> Empty Then arr(v, 9) = WorksheetFunction.SumIfs(Sheets("Data").Range("i:i"), _ Sheets("Data").Range("c:c"), arr(v, 1), Sheets("Data"). _ Range("b:b"), arr(v, 2)) End If If arr(v, 8) > b And arr(v, 1) <> Empty Then arr(v, 10) = arr(v, 8) - b End If If arr(v, 1) = arr(v - 1, 1) And arr(v, 2) = arr(v - 1, 2) Then For m = 1 To 10 arr(v, m) = Empty Next v = v - 1 t = t - arr(v, 8) End If v = v + 1 End If Next If arr(v - 1, 1) <> Empty Then For Z = 1 To 10 arr(v, Z) = Empty Next arr(v, 11) = t t = 0 v = v + 1 End If Next For Z = 1 To 10 arr(1, Z) = Cells(3, Z) Next Range("a3").Resize(v - 1, 11) = arr Range("b" & v + 2).FormulaR1C1 = "Total" Range("h" & v + 2).FormulaR1C1 = "=SUBTOTAL(9,R4C8:R[-1]C)" Range("i" & v + 2).FormulaR1C1 = "=SUBTOTAL(9,R4C9:R[-1]C)" Range("j" & v + 2).FormulaR1C1 = "=SUBTOTAL(9,R4C10:R[-1]C)" Range("k" & v + 2).FormulaR1C1 = "=Sum(RC[-3]-RC[-1])" 'Range("k" & v + 2).FormulaR1C1 = "=SUBTOTAL(9,R4C8:R[-1]C[-3])-SUBTOTAL(9,R4C10:R[-1]C[-1])" Sheets("Tra. Exc ").Activate Range("G6").FormulaR1C1 = "=Excursion!R" & v + 2 & "C9" 'Range("G6").Value = Sheets("Excursion").Range("I" & v + 2).Value Application.Calculation = xlCalculationAutomatic Sheets("Excursion").Activate End Sub وهذا هو ملف مصغر به شكل النتائج بالضبط في يوم 01/03/2019 فياريت أتمنى المساعدة على اخراج النتائج على نفس هذا الشكل وجزاكم الله كل خير وبارك الله فيكم جميعا على المساعدة جلب بيانات بالتاريخ دون تكرار 2 - Copy.xlsm

لسلام عليكم وهذه ايضا شكل النتائج المطلوب جلبها بالضبط كمثال فى يوم 01/03/2019 رجاءا المساعدة بارك الله فيكم جميعا

للرفع بارك الله فيكم

للرفع أكرمكم الله

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

ارجو من حضراتكم المساعدة فأيضا كانت هناك مشاركة وعمل مميز وكود رائع فى هذا الموضوع ايضا لأستاذنا الكبير المتألق دائما والساعى دائما الى مساعدة كل من يحتاج الى المساعدة سليم حاصبيا له منا كل المحبة والإحترام وجزاه الله كل خير ورحم الله والديه ووسع الله فى رزقه وبارك الله دائما وابدا فى اولاده

السلام عليكم اساتذتى الأحباء بارك الله فيك استاذ أبو نور على هذا العمل الممتاز-ولكن عند عمل بعض التعديلات ظهرت معى بعض المشاكل عند تنفيذ الكود وهو عدم تطابق المجموع النهائى مع ما هو وارد بالعمود J من صفحة Data كما حدث خطأ اخر وهو عدم ظهور الأسعار كما بالسابق فى العمودين E & F من صفحة Excursion وكان الكود يأخذ هذه الأسعار من صفحة Price رجاءا اتمنى ان يكون هناك حل فى ضبط هذا الكود بارك الله فيكم جميعا وجزاكم الله كل خير جلب بيانات بالتاريخ دون تكرار 2.xlsm

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

وعليكم السلام المطلوب غير واضح وغير منطقى لابد من وضع بيانات فى الملف وشرح المطلوب بدقة كافية

وعليكم السلام لا يمكن عمل هذا استاذ فهيم