طارق محمود

السلام عليكم تفضل pivot2.rar

السلام عليكم الاول: تساؤل .. هل أذا اردت ان يعمل الملف لدي في بيئة الأوفيس 2007 أن أحفظ الملف بهذه الصيغة Excel 2007 Macro-Enabled Workbook نعم ، كل ماعليك ان تحفظه بتلك الصيغة ذات الإمتداد xlsm الثاني لاحظت أن الكود يقوم بداية بمسح جميع البيانات في العمود المذكور ثم يقوم بجلب أسماء الصور هل جلب البيانات يعتمد على التسلسل في الموقع أو الأسم أو تاريخ أضافته إلى الفهرس جلب البيانات يعتمد على الملفات الموجودة بالفعل في الموقع أرجو التعديل في الكود بحيث أن لا يقوم بمسح البيانات ابتداءاً وأن يتحسس أذا كان الاسم موجود مسبقاً يحافظ على مكانه في الخلايا ويضيف فقط الصور المستجدة (والسبب أني بجانب كل أسم أضيف وصف للصورة وبهذه الحالة سوف يتغير مكان الوصف لكل أسم) تفضل المرفق وبه ماطلبت قاعدة بيانات صور.rar

السلام عليكم أخي العزيز / إبراهيم الطلب بسيط إن شاء الله ولكن لن يكون أسفل الأعمدة ، بل أعلاها لو تتبعت الشرح السابق تجد أنك ممكن عمل ذلك في الورقة Sample حيث ينسخ منها الكود باقي الورقات تفضل الملف وبه التعديل Code_Explain5.rar

السلام عليكم ولك مثل دعاؤك وزيادة أخي الحبيب / أبا أنس

السلام عليكم أخي العزيز كنت أفضل ان تعمل التعديلات بنفسك بعد أن دللتك علي الرابط السابق ولكن لابأس تم إضافة بعض الصور للتجربة وتم تعديل النطاق الديناميكي الدال علي الصورة الذي إسمه fine2 وتم إضافة المعادلة التالية بالخلية F1 =MATCH(B3,sheet2!B:B,0)-1 نسيت تقول أن كلمة السر 123 تفضل الملف وبه المطلوب كل عام وأنتم بخير تلاميذ الدار.rar

السلام عليكم أخي العزيز راجع الموضوع علي الرابط التالي بداية من مشاركة رقم 9 http://www.officena.net/ib/index.php?showtopic=37231&hl=%D8%B5%D9%88%D8%B1%D8%A9#entry198965

السلام عليكم أخي الحبيب عندك حق تم التعديل في نفس المشاركة

السلام عليكم أخي الغالي / أبا أنس جرب هذا الكود في حدث الملف Private Sub Workbook_Open() pth = ActiveWorkbook.Path & "\MyImage\" Range("Z2:Z" & [Z60000].End(xlUp).Row).ClearContents x = Dir(pth) Do While x <> "" i = i + 1 Sheets(1).[Z1].Offset(i, 0).Value = Left(x, Len(x) - 4) x = Dir() Loop End Sub

السلام عليكم أخي / أحمد حجازي مرور سريع علي الحل وشرح للكود قبل أن تحمل الملف تم إنشاء ورقة إسمها Sample كنموذج لشكل التقرير الذي تريده تم إخفاء هذه الورقة Sample فلن تراها إلا لو أظهرتها تم إضافة كود في حدث الورقة (يتحسس التغيير بالورقة) أي يتم تحفيز عمل الكود أوتوماتيكيا إذا تم أي تغيير في الورقة Sheet1 بناءا علي الخطوات التالية إذا تم تغيير في عمود غير العمود D الذي به إسم الشركة فلن يجري أي خطوات إذا تم التغيير في العمود D فسوف يمرعلي جميع صفوف الورقة من الصف 2 إلي آخر صف به بيانات بالعمود D ثم يقوم بعمل المراجعة التالية قبل خطوات الترحيل (.......) اذا كان موجود بالعمود N كلمة OK فهذا يعني أن هذا الصف تم ترحيله من قبل فيتجاوزه للي بعده (.......) اذا كان عدد البيانات بالأعمدة A:D لاتساوي 4 أولايوجد بيان واحد في الدائن والمدين فهذا يعني أن بيانات هذا الصف ناقصة فيتجاوزه أيضا للي بعده بعد إنهاء المراجعات السابقة ، يبدأ الترحيل إذا كان الملف يحتوي علي ورقة بإسم الشركة الموجودة بالعمود D فيبدأ الترحيل وإلا يكون ورقة جديدة بنفس الإسم (وهنا يتم إظهار الورقة Sample ليستعملها ثم يخفيها) والآن أتركك مع الكود والملف بالمرفق Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 4 Then Exit Sub LastR = [D10000].End(xlUp).Row Application.ScreenUpdating = False For r = 2 To LastR If Cells(r, "N") = "OK" Then GoTo 10 If WorksheetFunction.CountA(Range("A" & r & ":D" & r)) < 4 Or _ WorksheetFunction.Count(Range("G" & r & ":H" & r)) <> 1 Then GoTo 10 nm = Cells(r, "D") For ws = 1 To Sheets.Count If Sheets(ws).Name = nm Then GoTo 5 Next ws Sheets("Sample").Visible = True Sheets("Sample").Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = nm Range("B1").Value = nm Sheets("Sample").Visible = False Sheets("Sheet1").Activate 5 ' Tarheel rr = Sheets(nm).[A10000].End(xlUp).Row + 1 Cells(r, "N") = "OK" Union(Range("A" & r & ":C" & r), Range("G" & r & ":H" & r)).Copy (Sheets(nm).Cells(rr, 1)) 10 Next r Application.ScreenUpdating = True End Sub Code_Explain4.rar

السلام عليكم أخي / عبد الله تقبل الله منا ومنكم صالح الأعمال وجزاك الله كل الخير علي جهدك الدؤوب بالمنتدي

السلام عليكم أخي العزيز ، الحبيب / محمود عندك حق الصح 360 ولكني لست محاسبا فكثيرا ماأغفل عن هذا أيضا الجزء الأول من المعادلة (الشرط) ، أعتقد أنه لابد أن يكون 365 ، أم ماذا تري؟ عموما المعادلة ستكون كالتالي =IF(($G$1-B2)>365,C2*((1+2%)^(($G$1-B2)/360)-1),C2*((1+3%)^(($G$1-B2)/360)-1)) =IF(($G$1-B2)>365,C2*((1+2%)^(($G$1-B2)/360)-1),C2*((1+3%)^(($G$1-B2)/360)-1)) والحمد لله الفكرة وصلت ويستطيع السائل تعديلها كما يناسبه

السلام عليكم أخي الفاضل تفضل المرفق وبه ماطلبت Interest.rar

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

السلام عليكم تم الرد علي هذا في الموضوع التالي http://www.officena....71 مشاركة # 7

السلام عليكم أخي العزيز عذرا للتأخير تفضل المرفق وبه الشرح 400.rar

السلام عليكم أخي العزيز أنت تستخدم إكسل 2007 أو مافوقه لذلك يجب عليك إن أردت حفظ ملف ما به أكواد ،يجب أن تحفظه بصيغة xlsm وليس xlsx ببساطة عندما يكون الملف عادي بلا أكواد ، تحفظه مباشرة علي الوضع العادي xlsx الخيار الأول في حفظ بإسم - save as وعندما يكون بالملف أي كود ، تحفظه علي الوضع العادي xlsm الخيار الثاني في حفظ بإسم - save as ملحوظة سأحذف الموضوع الآخر للتكرار

السلام عليكم جزاكم الله خيرا إخواني ماشاء الله حلول رائعة بارك الله فيكم بعد إذنكم سأجيب عن سؤال سال الأخ إبراهيم وسأل الأخ أبو صلاح وإجابتهما واحدة وهي أنك تضع رقم لدالة البحث وأنت تعرف مسبقا أنه غير موجود فتبحث في المجال المطلوب حتي آخر رقم فلاتجده فتعيد إليك آخر رقم في السؤال الأول الدالة LOOKUP تبحث عن 9.99999999999999E+3078 أي 1 وبجواره 308 أصفار فهو رقم كبير ولايمكن ان يتواجد في البيانات 420 430 428 إذن ستعود لنا الدالة بآخر مقارنة تمت بين هذا الرقم وأرقام المجال وبالمثل في السؤال الثاني الرقم 100000000000 أكيد غير موجود في المجال

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

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

السطر المراد التعديل به Range(Cells(r, 1), Cells(r, 13)).Copy مثلا لو أردنا النسخ من العمود 3 إلي العمود 7 فسيكون السطر كالتالي Range(Cells(r, 3), Cells(r, 7)).Copy أما إذا كان المجال المنسوخ غير متصل مثلا المجال من العمود 2 إلي العمود 4 بالإضافة للمجال من العمود 6 إلي العمود 7 بالإضافة للمجال من العمود 9 إلي العمود 11 فسيكون السطر كالتالي Union(Range(Cells(r, 2), Cells(r, 4)), Range(Cells(r, 6), Cells(r, 7)), Range(Cells(r, 9), Cells(r, 11))).Copy

وقد فضلت ان تكون الإجابة هنا لتعم الفائدة مرفق ملف به الكود والشرح السطر المراد التعديل به هو السطر التاسع ، لون برتقالي / بني Code_Explain3.rar

السلام عليكم سألني أحد الإخوة عن التعديل في الكود التالي مع الشرح السؤال "المطلوب تعديل بسيط فى الكود بحيث ترحيل اعمده معينه هنااا فى هذا الكود بيرحل 15 عمود كلهم يعنى بيرحل الشيت كله لكن انا طلبى انه يرحل اعمده معينه انا اللى اختارها بنفسى ويا ريت تكون طريقه الشرح والتوضيح " Sub ahmed() Application.ScreenUpdating = False Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets For r = 8 To 300 If sh.Name = "Sheet1" Then GoTo 2 If Cells(r, 5).Value <> Empty Then If Cells(r, 5).Value = sh.Name Then Range(Cells(r, 1), Cells(r, 13)).Copy QQ = sh.Cells(1000, 1).End(xlUp).Row + 1 sh.Range("a" & QQ).PasteSpecial xlPasteValues End If End If Next 2 Next Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

السلام عليكم أخي العزيز كان يجب أن تسجل الكود بالعناوين النسبية بدلا من تثبيت العناوين كما فعلت مرفق حل بالمعادلات ، أعتقد أنها الأنسب في هذه الحالة Test 1_TAREQ.rar

السلام عليكم أخي العزيز تفضل المرفق يوجد مشكلة في التحميل !!! عموما عندك أيضا الصيدلي 6 ، يجب إضافته في الخلية H18 للحل ضع الأرقام الزوجية 2،4،6،8،10،12 في الخلايا C17 ، D17 ، E17 ، F17، G17، H17 ،H17 أي أن ضع 2 في الخلية C17 و 4 في الخلية D17 و 6 في الخلية E17 و 8 في الخلية F17 و 10 في الخلية G17 و 12 في الخلية H17 ثم ضع المعادلة التالية في الخلية C19 =IF(OFFSET($A$1,MATCH($E$16,$A:$A,0)-1,C$17-1)=$G$16,IF(OFFSET($A$1,MATCH($E$16,$A:$A,0)-1,C$17)=$B19,OFFSET($A$1,5,C$17-1),""),"") وانسخها في الخلايا الخضراء أي حتي الخلية H20 (بعد إضافه الصيدلي 6 في الخلية H18)

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