saad abed قام بنشر نوفمبر 18, 2012 مشاركة قام بنشر نوفمبر 18, 2012 اخوانى الاعزاء السلام عليكم ورحمة الله وبركاته ارجو القاء نظرة على الكود التالى الكود يعمل فى وجود المتغيرات الثلاثة طبيعى سؤالى هو اذا غاب التاريخ من الى لماذا لا يبحث عن المتغير الاساسى اشكركم سعد عابد Sub report1() On Error Resume Next Application.ScreenUpdating = False For R = 5 To Sheets("مشتريات").[b10000].End(xlUp).Row If Sheets("مشتريات").Cells(R, 6) = Sheets("report").[c3] Then If Sheets("مشتريات").Cells(R, 5) >= Sheets("report").[g3] Then If Sheets("مشتريات").Cells(R, 5) <= Sheets("report").[j3] Then With Sheets("report").[b10000].End(xlUp) .Offset(1, 0) = Sheets("مشتريات").Cells(R, 2) .Offset(1, 1) = Sheets("مشتريات").Cells(R, 3) .Offset(1, 2) = Sheets("مشتريات").Cells(R, 4) .Offset(1, 3) = Sheets("مشتريات").Cells(R, 5) .Offset(1, 4) = Sheets("مشتريات").Cells(R, 7) .Offset(1, 5) = Sheets("مشتريات").Cells(R, 8) .Offset(1, 6) = Sheets("مشتريات").Cells(R, 9) .Offset(1, 7) = Sheets("مشتريات").Cells(R, 10) End With End If Next Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر نوفمبر 18, 2012 مشاركة قام بنشر نوفمبر 18, 2012 السلام عليكم و رحمة الله وبركاته اخي سعد فين الملف انته هنا حددت قيمة تاريخ البداية و النهاية لذلك في حال ترك الخانتين فارتين سوف يعتبر التاريخ 0 صفر اذا سوف يبحث عن التاريخ اكبر من او يساوي صفر الى تاريخ اضر من او يساوي صفر طيب ايه الحل تعطية شرط الذا كان خانة من تاريخ فارغة او تساوي صفر اذا تأخذ اصغر قيمة تاريخ موجودة في شيت مشتريات و تعطيه شرط اذا كان خانة الى تاريخ فارة او تساوي صفر اذا تأخذ اكبر قيمة تاريخ موجودة في شيت مشتريات هل هذا واضح رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر نوفمبر 19, 2012 الكاتب مشاركة قام بنشر نوفمبر 19, 2012 اخى فى الله احمد زمان(ابوابراهيم) اولا وحشنا اسال الله ان يجمعنا فى جنة الخلد انشاء الله درس جميل جدا ومعلومات قيمة لكن حاولت وفشلت واليك الملف report.rar رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر نوفمبر 19, 2012 مشاركة قام بنشر نوفمبر 19, 2012 السلام عليكم تم تعديل الكود ليصبح Sub report1() Application.ScreenUpdating = False On Error Resume Next Set Mysh = Sheets("مشتريات") Range("B7:H47").ClearContents If [F3] = "" Then DateFrom = CDate(Application.Min(Mysh.[E5:E20])) Else DateFrom = [F3] If [I3] = "" Then DateTo = CDate(Application.Max(Mysh.[E5:E20])) Else DateTo = [I3] '======================================================== For r = 5 To Mysh.[b10000].End(xlUp).Row If [C3] = Mysh.Cells(r, 6) And Mysh.Cells(r, 5) >= DateFrom And Mysh.Cells(r, 5) <= DateTo Then Mysh.Cells(r, 2).Resize(1, 7).Copy Range("B" & [b10000].End(xlUp).Row + 1) End If Next r Set Mysh = Nothing End Sub رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر نوفمبر 19, 2012 مشاركة قام بنشر نوفمبر 19, 2012 شاهد المرفق report.rar رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر نوفمبر 19, 2012 مشاركة قام بنشر نوفمبر 19, 2012 (معدل) السلام عليكم ربما هكذا Sub report1() On Error Resume Next Dim A As Range, B As Range Application.ScreenUpdating = False Set A = Sheets("report").[G3] Set B = Sheets("report").[J3] For R = 5 To Sheets("مشتريات").[b10000].End(xlUp).Row If Sheets("مشتريات").Cells(R, 6) = Sheets("report").[c3] Then If Sheets("مشتريات").Cells(R, 5) >= A And Not IsEmpty(A) Then GoTo 0 If Sheets("مشتريات").Cells(R, 5) <= B And Not IsEmpty(B) Then GoTo 0 With Sheets("report").[b10000].End(xlUp) .Offset(1, 0) = Sheets("مشتريات").Cells(R, 2) .Offset(1, 1) = Sheets("مشتريات").Cells(R, 3) .Offset(1, 2) = Sheets("مشتريات").Cells(R, 4) .Offset(1, 3) = Sheets("مشتريات").Cells(R, 5) .Offset(1, 4) = Sheets("مشتريات").Cells(R, 7) .Offset(1, 5) = Sheets("مشتريات").Cells(R, 8) .Offset(1, 6) = Sheets("مشتريات").Cells(R, 9) .Offset(1, 7) = Sheets("مشتريات").Cells(R, 10) End With End If 0: Next Application.ScreenUpdating = True End Sub تم تعديل نوفمبر 19, 2012 بواسطه عباد رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر نوفمبر 19, 2012 مشاركة قام بنشر نوفمبر 19, 2012 السموحه منك استاذ احمد لم ارى ردك الاكثر من رائع الا بعد ارسال المشاركه رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر نوفمبر 19, 2012 الكاتب مشاركة قام بنشر نوفمبر 19, 2012 اخى وحبيبى فى الله ابواحمد عبدالله المجرب اشكرك كل الشكر كل يوم بنتعلم منك شئ جديد بارك الله فيك شكرا لك وجزاك الله خيرا اخى وحبيبى ابونصار احسن انك لم ترى الرد علشان اعرف ان هناك اخوة فى الله هم كثر خلفى يساعدونى اشكرك لانك عدلت الكود لكى افهم الخطأ فين بارك الله فيكم سعد عابد رابط هذا التعليق شارك More sharing options...
الخالدي قام بنشر نوفمبر 19, 2012 مشاركة قام بنشر نوفمبر 19, 2012 ولإثراء الموضوع عدل الاسطر التالية: If Sheets("مشتريات").Cells(R, 6) = Sheets("report").[c3] Then If Sheets("مشتريات").Cells(R, 5) >= Sheets("report").[g3] Then If Sheets("مشتريات").Cells(R, 5) <= Sheets("report").[j3] Then عدلها الى: If IIf(Sheets("report").[c3] = "", 1, Sheets("مشتريات").Cells(R, 6) = Sheets("report").[c3]) Then If IIf(Sheets("report").[g3] = "", 1, Sheets("مشتريات").Cells(R, 5) >= Sheets("report").[g3]) Then If IIf(Sheets("report").[j3] = "", 1, Sheets("مشتريات").Cells(R, 5) <= Sheets("report").[j3]) Then رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر نوفمبر 19, 2012 مشاركة قام بنشر نوفمبر 19, 2012 السلام عليكم و رحمة الله وبركاته اخي سعد مين قدك ياعم وصلك الحل من 3 عباقرة كل التحية والتقدير للجميع اخي الحبيب ابو احمد اخي العزيز ابو نصار الأستاذ الفاضل صاحب الفضل الخالدي رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر نوفمبر 19, 2012 الكاتب مشاركة قام بنشر نوفمبر 19, 2012 اخى احمد زمان فعلا عندك حق وانا والله اشكرك كل الشكر على معلوماتك التى تعلمها لى ولغيرى المساعدين كثر وهم اهل فضل اشكركم جميعا الاستاذ الخالدى شكرا لك فهمت من تعديلك وتعديل ابونصار الكثير اشكرك اخى الف شكر سعد عابد رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان