طارق محمود

أخي الحبيب / إبراهيم ابوليله جزاك الله خيرا شاكرا مرورك الجميل ===================== أخي الحبيب / ياسر خليل أخي الحبيب / محمد لطفي جزاكما الله خيرا علي حسن الظن والكلمات الطيبة لو تيسر الوقت سأفعل إن شاء الله ​

السلام عليكم أرجو أن أكون فهمت المطلوب تفضل المرفق CUM2.rar

السلام عليكم إذا اعتمدنا علي أن العمود الأول من الجدول لن يكون به بيانات في حالة أن يكون الصف تجميعي يمكنك عمل تنسيق شرطي كالتالي =$A11="" وتضع ماتشاء من تلوين وتكبير وخلافه حين يتحقق الشرط انظر المرفق aaaa2.rar

السلام عليكم أخي العزيز السطر التالي من الكود يتم تنفيذه أثناء تنشيط الورقة الأولي "فاتورة بيع" Dt = [J12]: BillN = [F14]: Tr_C = [J14]: Clnt = [J15]: n = LR - 17 وهو عبارة عن 5 أوامر مجتمعة يكافيء التالي Dt = [J12] BillN = [F14] Tr_C = [J14] Clnt = [J15] n = LR - 17 وكل جزء يأخذ قيمة من الورقة ويسجلها لنقلها فيما بعد للورقتين التاليتين أما الجزء n = LR - 17 بالتحديد فهو يعتمد علي أن أول بيانات مكتوبة بالورقة ستكون بالصف 18 فإذا لم يكتب بالفاتورة غير صنف واحد فيكون آخر صف LR = 18 وستأخذ n القيمة n = 18 - 17 =1 وهكذا فالمتغير n يعبر عن عدد الأسطر في الفاتورة ======================= الشق الثاني nr + n - 1 وهذا يحدث في الورقتين الأخريتين بعد أن تكون نسخت البيانات وسجلتها كما سبق ولفهم هذه الجزئية لترجع قليلا في الكود ستجد الأوامر كالتالي nr = [F9999].End(xlUp).Row + 1 أي أن nr سيأخذ قيمة رقم الصف الجديد الجاهز للبيانات في تلك الورقات new row وعند الخلية التي بهذا السطر الجديد وتكون بالعمود F يتم لصق قيم لماسبق نسخه Cells(nr, "F").PasteSpecial Paste:=xlPasteValues ثم بفرض أن عدد أسطر الفاتورة التي يتم نقلها 3 إذن الصيغة التالي Range("E" & nr & ":E" & nr + n - 1) = Clnt تضع قيمة العميل Clnt في الأسطر الثلاثة بالعمود E والتي تبدأ من الصف الجديد الجاهز للبيانات مثلا إذا آخر الصف الجديد الجاهز للبيانات =20 وعدد أسطر الفاتورة التي يتم نقلها = 3 إذن Range("E" & nr & ":E" & nr + n - 1) = Clnt تعني Range("E" & 20 & ":E" & 20 + 3 - 1) = Clnt أي Range("E20:E22") = Clnt

بارك الله فيك أخي الحبيب الغالي / ياسر خليل مرورك الكربم شرف عظيم

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

تفضل الملف به الشرح مشاكل نموذج الدوائر الاولي3.rar

السلام عليكم شاكر لكم جميعا مروركم العطر وكلماتكم الطيبة ================================= الأخ الفاضل / aysar_0078 تجد بالمرفق أخي شيت جديد لشرح الحل تفضل تجربة2.rar

أنا بالفعل عدلت بعض الأشياء لتوحيد الأسماء تفضل الملف بعد الحل نموذج الدوائر الاولي2.rar

السلام عليكم أخي الكريم بداية لابد من توحيد الألفاظ ليتعرف عليها الأكسل مثلا في الورقة الأولي "قتل" والثانية "قتـــل" لن يتساويا في الاكسل ثانيا سأرد عليك قريبا إن شاء الله

السلام عليكم أخي الكريم 1- سأغير عنوان الموضوع ليكون ملتزما بقواعد المشاركة أرجو الالتتزام في المستقبل 2- تفضل المرفق به ماطلبت وأكثر تجربة.rar

السلام عليكم الأخت السائلة الإخوة المهتمون تفضلوا الملف المرفق به المطلوب سرعة الرياح.rar

وجدت علي الشبكة ملف قد يفيد http://www.4shared.com/get/L8rF7n8tba/Wind_Speed_Data.html

جائني السؤال التالي علي الخاص ======================= 1-اريد طريقه لايجاد التكرار لسرعة الرياح المقاسه كل عشر دقائق لمدة سنه كامله. 2-كيف نحسب الانحراف المعياري لنفس الداتا. شكرا ========================== أحببت أن أضعه ليتاح للأعضاء المهتمين الاستفادة والمشاركة أيضا

السلام عليكم أخي العزيز لم أكن قد قرأت ردود الأخوة الأعزاء وكنت قد جهزت ردا ثم وجدت الردود وحملت المثال الذي رفعته أنت ووجدت أنني قمت بالشرح لأقرب مايكون لما تريد بالمرفق تجد 3 شيتات (المعطيات - التنبؤ الخطي - التنبؤ المنحني) وبه شرح تفصيلي إن شاء الله يكون هذا ماتريد وتستطيع تطويعه لما تريد تفضل التنبؤ.rar

"كيف تم التعديل" ================ تم التعديل علي خطوتين الخطوة 1- ظلل المجال F3:F20 الذي به الأرقام ثم استبدل كل الفاصلات (الكومة) بلاشيء لعمل ذلك بعد التظليل إضغط Ctrl-H بالمستطيل العلوي تستبدل ماذا اكتب له , ثم بالمستطيل الأسفل تستبدلها بماذا فلاتكتب شيء فيه ونفذ الأمر سيعيد تلك الاشكال إلي صيغتها الرقمية الخطوة 2- من التنسيق لنفس المجال إختر تنسيق خاص Custom ثم اكتب الصيغة 0,000.00

السلام عليكم أخي الكريم هذه ليست أرقام الأرقام إذا وقفت عليها تجد قيمتها بأعلي الجدول وليس شكلها تم تعديلها لتكون أرقام تفضل المرفق 00-2.rar

تفضل أخي الملف يبدو ان المعادلات متشابكة ببعضها بطريقة مزعجة عموما تم عمل تحسين بسيط سوف تشعر به 2نسخة.rar

أخي الريفي جزاك الله كل خير الفكرة جميلة فعلا لك كل الاحترام والتقدير

السلام عليكم الأخ الحبيب / engreda عندك حق لقد خانني التعبير ============ والأدق أنني لم أجد التفاعل وليس التشجيع ، لو راجعت تواريخ المشاركات ستجد أنني بدأت في أول 2008 (كان عمري وقتها 45 والآن 51 ) وانقطعت تقريبا بعد 6 أشهر من التفاعل الضعيف ثم سألني أخي وصديقي م/شريف عبد الباسط سؤال في الموضوع بعد 4 سنوات من طرحه فأجبته وقتها وبعد ذلك لم يتفاعل أحد مع الموضوع اللهم إلا الأخ / Baher Mostafa في أوائل هذا العام ثم حضرتك اول أمس ثم أنني لم أكن قد أعددت موضوعا متكاملا ، فقط ظننت أن هذا النوع من العلوم قد يفيد بعض المهندسين ولم أعد موضوعا متكاملا بل حلقات كنت أقوم بإعدادها في وقتها وقد أصبح أن هذا الطرح قديما نسبيا بعد كل هذه المقدمة يؤسفني أخبرك أنني شخصيا قد بعدت كثيرا عن الموضوع حيث أخذتني مشاغل الحياة وقد أحتاج وقت حتي أراجع ماكتبت سابقا ثم أستطرد فيه مرة أخري وللأسف لاأملك الوقت حاليا ولكن إن يسر الله لي الوقت ، فسأفعل بإذن الله

باسوورد الحماية؟؟

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

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

السلام عليكم أخي الكريم تفضل الملف به ماطلبت برامج ولجان2.rar

السلام عليكم أخي الحبيب أولا بالنسبة لمقاس الشيك قابلتني مشكلة مشابهة وحللتها كالتالي صور عدة نسخات للإستخدام والتضبيط قطع الصور المنسوخة لتكون نفس مقاس الشيك جهز بيانات لشيك وهمي علي الإكسل حاول الطباعة عدة مرات مع تغيير هوامش الصفحة في الإكسل ومقاس الورقة علي الطابعة ستنجح إن شاء الله بعد محاولتين أو ثلاثة ثانيا بالنسبة للتفقيط إليك هذا الكود تغير فيه العملة والوحدات كما تشاء ثم تضعه في إعدادات الاكسل علي الجهاز وهذا الكود ليس من أعمالي أنا نسخته من المنتدي (قد يكون لأستاذنا النابغة / عبدالله باقشير) Function SpellNumber(ByVal MyNumber, _ Optional pbNum As Boolean = True, _ Optional ptCur As String = "Yuan", _ Optional ptDec As String = "Jiao", _ Optional ptPlu As String = "") Dim Curr, Decm, Temp Dim DecimalPlace, Count Dim vtPHolder As String ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " '' String representation of amount If Mid(MyNumber, 1, 1) = "-" Then MyNumber = Mid(MyNumber, 2, Len(MyNumber) - 1) End If MyNumber = Trim(Str(MyNumber)) '' Position of decimal place 0 if none DecimalPlace = InStr(MyNumber, ".") '' Convert decimal part, and set MyNumber to currency amount If DecimalPlace > 0 Then vtPHolder = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2) If pbNum = True Then Decm = GetTens(vtPHolder) Else Decm = vtPHolder End If MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp = GetHundreds(Right(MyNumber, 3)) If Temp <> "" Then Curr = Temp & Place(Count) & Curr If Len(MyNumber) > 3 Then MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop Select Case Curr Case "" Curr = "" Case "One" Curr = "One " & ptCur Case Else Curr = Curr & " " & ptCur & "" End Select Select Case Decm Case "" Decm = "" Case "One", "01" If Curr = 0 Or Curr = "" Then Decm = Decm & " " & ptDec Else Decm = " and " & Decm & " " & ptDec End If Case Else If Curr = 0 Or Curr = "" Then Decm = Decm & " " & ptDec & ptPlu Else Decm = " and " & Decm & " " & ptDec & ptPlu End If End Select SpellNumber = Curr & Decm End Function '******************************************* ' Converts a number from 100-999 into text * '******************************************* Function GetHundreds(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) 'Convert the hundreds place If Mid(MyNumber, 1, 1) <> "0" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred " End If 'Convert the tens and ones place If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & GetTens(Mid(MyNumber, 2)) Else Result = Result & GetDigit(Mid(MyNumber, 3)) End If GetHundreds = Result End Function '********************************************* ' Converts a number from 10 to 99 into text. * '********************************************* Function GetTens(TensText) Dim Result As String Result = "" 'null out the temporary function value If Val(Left(TensText, 1)) = 1 Then 'If value between 10-19 Select Case Val(TensText) Case 10: Result = "Ten" Case 11: Result = "Eleven" Case 12: Result = "Twelve" Case 13: Result = "Thirteen" Case 14: Result = "Fourteen" Case 15: Result = "Fifteen" Case 16: Result = "Sixteen" Case 17: Result = "Seventeen" Case 18: Result = "Eighteen" Case 19: Result = "Nineteen" Case Else End Select Else 'If value between 20-99 Select Case Val(Left(TensText, 1)) Case 2: Result = "Twenty " Case 3: Result = "Thirty " Case 4: Result = "Forty " Case 5: Result = "Fifty " Case 6: Result = "Sixty " Case 7: Result = "Seventy " Case 8: Result = "Eighty " Case 9: Result = "Ninety " Case Else End Select Result = Result & GetDigit(Right(TensText, 1)) 'Retrieve ones place End If GetTens = Result End Function '******************************************* ' Converts a number from 1 to 9 into text. * '******************************************* Function GetDigit(Digit) Select Case Val(Digit) Case 1: GetDigit = "One" Case 2: GetDigit = "Two" Case 3: GetDigit = "Three" Case 4: GetDigit = "Four" Case 5: GetDigit = "Five" Case 6: GetDigit = "Six" Case 7: GetDigit = "Seven" Case 8: GetDigit = "Eight" Case 9: GetDigit = "Nine" Case Else: GetDigit = "" End Select End Function Sub list_sheets() For i = 1 To Sheets.Count ActiveCell(i, 1) = Sheets(i).Name Next End Sub