ياسر خليل أبو البراء

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

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

أخي الحبيب أبو حنين أحبك الله الذي أحببتني فيه .. :fff: أرجو ألا تكون منزعج من كثرة إلحاحي بالتوضيح ... والحمد لله أن تم المطلوب على خير تقبل تحياتي

أخي الكريم أبو يوسف وجزيت بمثل ما دعوت لا تنسى التوجيهات ..تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

أخي الحبيب أبو حنين لم تثقل علي ..كل الفكرة أنني دائماً وأبداً أحب التوضيح التام للأمر ..لأن عدم التوضيح يؤدي إلى تضييع الوقت في مشاركات لا طائلة منها (هذا أسلوبي لو إنت متابع لمشاركاتي بالمنتدى) إليك الكود التالي يصلح لورقة العمل النشطة أي ورقة عمل سواء هذه الورقة أم تلك Sub FilterData() Dim WS As Worksheet Dim myCrit Set WS = ActiveSheet myCrit = WS.Range("D3") Application.ScreenUpdating = False With WS If Not IsEmpty(myCrit) Then .AutoFilterMode = False .Range("A4:G4").AutoFilter Field:=3, Criteria1:=myCrit Else .Cells.AutoFilter End If End With Application.ScreenUpdating = True End Sub تقبل تحياتي

أخي الكريم إليك التعديلات التي ستقوم بها لتستطيع أن تطبقه على ملفك ..أول خلية بها معادلة هي الخلية A6 لنفترض أنك تريد التطبيق على 6 قيم على سبيل المثال ROW($A$6) لنفترض أنك ستبدأ في الخلية A8 ..إذاً ستقوم بالتغيير في السطر السابق بدلاً من 6 اجعلها 8 ---------------------------------- SUM($B$1:$B$4) النطاق المطلوب جمعه في حالتك الجديدة سيكون إلى الصف السادس ، إذاً ستقوم بتغيير رقم 4 إلى رقم 6 ليناسب النطاق الجديد --------------------------------- INDEX($A$1:$A$4 غير رقم 4 إلى رقم 6 ليناسب النطاق الجديد (الذي به القيم الستة) ----------------------------- COUNTIF($A$5:A5 رقم 5 يمثل الخلية السابقة للمعادلة ... المعادلة الجديدة هتكون في A8 يبقا الصف السابق لها هو رقم 7 ...إذاً التغيير المطلوب هو أن تغير رقم 5 الموجود بالسطر إلى رقم 7 ------------------------------ $A$1:$A$4 $B$1:$B$4 قم بتغيير رقم 4 إلى 6 في كلا السطرين -------------------------- إليك الملف المرفق فيه التعديل كما شرحت لك لا تنسى أن تضغط على Ctrl + Shift + Enter لأنها معادلة صفيف ، ثم قم بسحبها إلى عدد الصفوف التي تريدها Repetition Gamal Officena.rar

إليك هذه الأكواد علها تفيدك فيما تطلب With ActiveSheet.PageSetup 'الصفوف المكررة إلى الأعلى .PrintTitleRows = "$3:$3" 'الأعمدة المكررة إلى اليسار .PrintTitleColumns = "$A:$A" End With '==================== ActiveSheet.PageSetup.PrintArea = "$A$1:$G$20" '==================== With ActiveSheet.PageSetup .LeftHeader = "أعلى يسار Up_Left" .CenterHeader = "Up_Middle أعلى وسط" .RightHeader = "أعلى يمين Up_Right" .LeftFooter = "Down_Left أسفل يسار" .CenterFooter = "أسفل وسط Down_Middle" .RightFooter = "Down_Right أسفل يمين" End With '==================== With ActiveSheet.PageSetup .LeftMargin = Application.CentimetersToPoints(1.5) .RightMargin = Application.CentimetersToPoints(1.5) .TopMargin = Application.CentimetersToPoints(2) .BottomMargin = Application.CentimetersToPoints(2) .HeaderMargin = Application.CentimetersToPoints(1.2) .FooterMargin = Application.CentimetersToPoints(1.2) End With '==================== With ActiveSheet.PageSetup 'طباعة رؤوس الصفوف والأعمدة .PrintHeadings = True 'طباعة خطوط الشبكة .PrintGridlines = True 'لا يتم طباعة التعليقات .PrintComments = xlPrintNoComments End With '==================== 'توسيط إلى عرض الصفحة .CenterHorizontally = False 'توسيط إلى ارتفاع الصفحة .CenterVertically = False 'طباعة طولية .Orientation = xlPortrait 'طباعة عرضية .Orientation = xlLandscape 'حجم الورق .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver 'طباعة أسود و أبيض .BlackAndWhite = True 'ملائمة إلى عرض الصفحة .FitToPagesWide = 1 .FitToPagesTall = False '==================== وهذا هو الشرح للأكواد * يقوم الكود الأول بضبط إعداد الصفحة لكي يتم طباعة الصف الثالث في كل الصفحات التي سيتم طباعتها ، بينما الجزء الثاني من الكود يقوم بطباعة العمود الأول في كل الصفحات ، أي أنه يقوم بطباعة الأعمدة إلى اليسار. * يقوم الكود الثاني بتحديد منطقة الطباعة ، أي أن الطباعة تكون للنطاق المحدد في الكود فقط. لإزالة منطقة الطباعة ، يتم استبدال النطاق بعلامتي تنصيص "" ، أي تترك فارغة بدون تحديد. * يقوم الكود الثالث بوضع نصوص في رأس وتذييل الصفحة ، كما هو موضح بالكود ، فيمكنك بكل مرونة تحديد المكان المطلوب عليه سواء في رأس الصفحة أو في تذييل الصفحة ، وكذلك المحاذاة (يمين - وسط - يسار). لإزالة رأس وتذييل الصفحة توضع علامتي تنصيص "" بعد علامة يساوي في كل سطر. * يقوم الكود الرابع بضبط حجم الهوامش (الهامش اليسار ، الهامش اليمين ، الهامش العلوي ، والهامش السفلي ، وهامش رأس الصفحة ، وهامش تذييل الصفحة). * يقوم الكود الخامس بطباعة رؤوس الصفوف والأعمدة ، وطباعة خطوط الشبكة ، وعدم طباعة التعليقات. لإزالة طباعة رؤوس الصفوف والأعمدة ، وإزالة طباعة خطوط الشبكة ، يتم استبدال القيمة True بــ False. * الجزء الأخير في آخر الكود المرفق مجموعة من الأكواد في أسطر ، مع شرح الهدف من كل كود. المصدر مكتبة الصرح .. للإطلاع على مكتبة الصرح روح لرابط الفهرس الموجود في التوقيع الخاص بي واعمل بحث عن كلمة "طباعة" ستجد "أكواد الطباعة"

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

شوف كدا إذا ظبطت معاك أم لا Recipe YK.rar

قم بتسجيل ماكرو سيظهر لك أسطر فيها المطلوب .. اختصر الأسطر بالشكل المناسب

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

أخي الكريم أبو حنين الرجاء التوضيح بشكل يزول معه أي لبس هل تريد تصفية البيانات في ورقتي العمل اللتين ذكرتهما ..بنفس الشرط ألا وهو الخلية D3 في ورقة العمل المسماة Medi. Kha ؟؟ أم أن كل خلية في كل ورقة عمل منفصلة عن الأخرى .. أقصد العمل سيكون على الخلية D3 في ورقة العمل Medi. Kha والخلية D3 في ورقة العمل Medi. Epe؟ بالمناسبة بالنسبة لملاحظتك أعتقد أنها لا تستحق ..كان من الواجب أن تقوم بالإطلاع على الكود أولاً ومعرفة لما تم تصفية البيانات بهذا الشكل ..لقد أسأت الفهم وفهمت العكس .. ولحل المشكلة بكل يسر قم بإزالة هذا الجزء من الشرط "<>" & من السطر .Range("A4:G4").AutoFilter Field:=3, Criteria1:="<>" & myCrit يرجى توضيح المطلوب من جديد بارك الله فيك وقم بإرفاق الملف مرة أخرى بعد وضع بعض البيانات في ورقة العمل المسماة Medi. Epe حتى يتسنى لنا تجربة الكود قبل رفعه

أخي الكريم أحمد رفقاً بإخوانك .. الوقت لدي ضيق جداً وأحاول أن أقدم المساعدة قدر استطاعتي ويلمس الكثير من الأعضاء ذلك الأمر .. مشكلتي أنني عندما أتناول موضوع معين ويشغل بالي أركز عليه حتى أنهيه بالشكل المناسب .. وصراحة أنا منشغل في برنامج المدرسة القرآنية للأخ أبو عبد الملك .. وهذا لا يمنعني من المشاركة قدر استطاعتي كل ما عليك أن توضح المطلوب وبالتفصيل لإخوانك في المنتدى وإن شاء الله مع قليل من الصبر والمثابرة وتوضيح المشكلة ستجد الحل عندما لا تجد استجابة لموضوعك فهذا لا يعني أن هناك تعنت من الأعضاء تجاهك بل تأكد أنهم لا يفهمون مطلوبك بشكل جيد .. وقد لا يعبرون عن ذلك في كثير من الأحيان ، وهذا ما أناشد به كل الأعضاء أن يقولوا أن الأمر غير واضح إذا وجدوا الأمر غير واضح .. والوضوح لا يعني توضيح بشكل عام بل بشكل تفصيلي يزول معه أي لبس .. حتى يستطيع الأخوة تقديم المساعدة المناسبة وإلا لحدث تخبط وكثرت المشاركات ولم يصل العضو صاحب المشكلة إلى حل مشكلته ... أرجو من الجميع الالتزام بالتوجيهات تقبلوا تحياتي

يرجى الالتزام بالتوجيهات واختيار أفضل إجابة ..إنت عضو قديم المفروض الحاجات الصغيرة دي متعديش منك ..مش كدا ولا ايه (على رأي عمو فؤاد)

جرب الكود بهذا الشكل Sub FilterData() Dim WS As Worksheet Dim myCrit Set WS = Sheets("Medi. Kha") myCrit = Range("D3") With WS .AutoFilterMode = False .Range("A4:G4").AutoFilter Field:=3, Criteria1:="<>" & myCrit End With End Sub تقبل تحياتي

أخي لا يوجد فورم بالملف إنما هي أكواد ودوال معرفة مجمعة معاً لتؤدي الغرض بالنسبة للمعادلات يوجد معادلات للتحويل بين الأنظمة العددية ولكنها لن تؤدي الغرض وستعطيك خطأ NUM .. والأكواد أفضل في النتائج من المعادلات خصوصاً مع البيانات الكثيرة حيث أن المعادلات في حالة البيانات الكثيرة تؤدي إلى كبر حجم الملف وبطء في التعامل معه .. وانتظر الأخوة الأعضاء لعلهم يفيدونك في حل بالمعادلات ...

أخي الكريم أبو العاصم شاهد هذا الفيديو فيه حل لمشكلتك إن شاء الله

أخي الكريم أبو حنين أعتقد أنه يجب التخلي قليلاً عن حدث ورقة العمل .. لاحظت أنك تركز على ذلك . ما بال عمل الأكواد وربطها بزر ؟ في وجهة نظري أفضل حتى لا يرتبط تنفيذ الكود بتغيير ما في خلية أو في خلايا .. يعني ببساطة أنا أنفذ الكود لما أحب ...ودا هيجنبك الكثير من المشكلات إليك الكود التالي .. كود يوضع في موديول Sub FilterData() Dim WS As Worksheet Dim myDate As Date Set WS = Sheets("Medi. Kha") If IsDate(Range("D2")) Then myDate = Range("D2") myDate = DateSerial(Year(myDate), Month(myDate), Day(myDate)) End If With WS .AutoFilterMode = False .Range("A4:G4").AutoFilter Field:=5, Criteria1:="<=" & myDate, Operator:=xlOr, Criteria2:=">" & myDate + 1 End With End Sub وليس في حدث ورقة العمل أما إذا أردته تلقائي وهذا أتوقعه فأعتقد أنك قد عرفت الطريق

من خلال أقواس الكود <> ستجدها بهذا الشكل . يرجى استخدامها لتظهر المعادلات والأكواد بالشكل المناسب تقبل تحياتي

أخي الفاضل النظام ليس هو النظام العشري بل هو النظام الثماني .. إليك الملف المرفق فيه ما تريد إن شاء الله Sub ConvertProcess() Dim I As Long Dim strbinnum, BitValue, BinNumSize, PlaceValue, lngBaseX Dim intNumber, intRemainder, strRemainder, strOctalNumber Application.ScreenUpdating = False Range("B2:F1000").ClearContents For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row Cells(I, 2).Value = RemovePeriods(Cells(I, 1).Text) + 0 Cells(I, 3).Value = DecimalToBinary(Cells(I, 2)) Cells(I, 4).Value = BinaryToOctal(Cells(I, 3).Text) Cells(I, 5).Value = SumDigits(Cells(I, 4)) Cells(I, 6).Formula = "=IF(" & Cells(I, 4).Address & "="""","""",MOD(" & Cells(I, 4).Address & "-1,9)+1)" Cells(I, 6).Value = Cells(I, 6).Value Next I Application.ScreenUpdating = True End Sub Public Function RemovePeriods(ByVal Txt) Application.Volatile If TypeOf Txt Is Range Then Txt = Txt.Text End If RemovePeriods = Replace(Txt, ".", "") End Function Public Function DecimalToBinary(DecimalNum As Long) As String Dim Tmp As String Dim N As Long N = DecimalNum Tmp = Trim(Str(N Mod 2)) N = N \ 2 Do While N <> 0 Tmp = Trim(Str(N Mod 2)) & Tmp N = N \ 2 Loop DecimalToBinary = Tmp End Function Function BinaryToOctal(strbinnum As String) Dim BitValue As String, BinNumSize As Long, PlaceValue, lngBaseX As Long, intNumber As Long, intRemainder As Long, strRemainder As String, strOctalNumber As String BinNumSize = Len(strbinnum) For PlaceValue = 0 To BinNumSize - 1 BitValue = Mid(strbinnum, BinNumSize, 1) BinNumSize = BinNumSize - 1 lngBaseX = (2 ^ PlaceValue * CInt(BitValue)) + lngBaseX Next PlaceValue intNumber = lngBaseX Do While intNumber >= 1 intRemainder = intNumber Mod 8 strRemainder = CStr(intRemainder) intNumber = intNumber \ 8 strOctalNumber = strRemainder & strOctalNumber Loop BinaryToOctal = strOctalNumber End Function Function SumDigits(Number) Dim I As Long For I = 1 To Len(Number) SumDigits = SumDigits + Val(Mid(Number, I, 1)) Next I End Function تقبل تحياتي Decimal & Binary & Octal Conversion.rar

أخي الكريم تقريباً فهمت بس محتاجة شوية وقت ..فقط رجاء ارفق نتيجة واحدة في صف واحد فقط لتأكيد المطلوب .. والمطلوب الجديد معاها بالمرة

روعة أخي علي الشيخ سلسلة رائعة وفي منتهى الجمال ربنا يبارك فيك ويجازيك خير

ارفق بعض النتائج المتوقعة للإطلاع عليها ..حيث أن النتائج صحيحة فيما فهمت من طلبك

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

مردتش عليا الله يسامحك عموماً حسب فهمي للمطلوب من ملف الأخ الغالي علاء رسلان بارك الله فيه جرب هذا الملف لعله يكون المطلوب Recipe YK.rar