نجوم المشاركات

وعليكم السلام ورحمة الله وبركاته كود المورد الموجود في النموذج ليس هو كود المورد وانما هو معرف جدول شجرة خسابات تم تعديل الكود كالتالي =DSum("[count_d]"; "[شراء]"; "[name_d] ='" & forms![moarden subform]![اسم الحساب] & "'") Database4.rar تحياتي

تفضل اخي الكريم empSalary.rar تحياتي

هكذا عمل لا يمكن للمعادلة ان تتحكم به لانه متعلق بموقع الشيت Month والله أعلم يمكن عمل ما تريد بواسطة الماكرو كما في الملف المرفق الكود Option Explicit Sub Free_summation() Dim M As Worksheet Dim M_index Dim first_index%, t% Dim S2#, S3#, S4#, S5#, S6# Set M = Sheets("Month") Dim Arr() M_index = M.Index If M_index = 1 Then Exit Sub If M_index > =13 Then M_index = 13 For t = 1 To M_index - 1 S2 = S2 + IIf(IsNumeric(Sheets(t).Range("B2")), _ Sheets(t).Range("B2"), 0) S3 = S3 + IIf(IsNumeric(Sheets(t).Range("B3")), _ Sheets(t).Range("B3"), 0) S4 = S4 + IIf(IsNumeric(Sheets(t).Range("B4")), _ Sheets(t).Range("B4"), 0) S5 = S5 + IIf(IsNumeric(Sheets(t).Range("B5")), _ Sheets(t).Range("B5"), 0) S6 = S6 + IIf(IsNumeric(Sheets(t).Range("B6")), _ Sheets(t).Range("B6"), 0) Next Arr = Array(S2, S3, S4, S5, S6) M.Range("B2").Resize(UBound(Arr) + 1) = _ Application.Transpose(Arr) End Sub Moustafa.xlsm

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم اولاً استخدمنا الوحدة النمطية لتقريب المبلغ عند التقسيم Public Function XRnd(strnr As Double) As Integer Dim myrnd, X As Double, newrnd As Double X = strnr \ 100 newrnd = X * 100 myrnd = strnr - newrnd XRnd = newrnd End Function ثم قمنا بتحديد القسط الشهري وباقي المبلغ من الكود التالي Dim X As Integer, X1 As Integer Me.amount = XRnd([totalamount] / [coden]) X = XRnd([totalamount] / [coden]) * coden X1 = totalamount - X وقمنا بالتوزيع بالشكل التالي mySQL = "Select * From Sharevalue" Debug.Print mySQL Set rst = CurrentDb.OpenRecordset(mySQL) For i = 1 To Me.coden rst.AddNew rst!codec = Me.codec rst!amount = Me.amount rst!coden = i rst.Update Next i ثم تحديث قيمة اخر قسط كالتالي mySQL1 = "Select * From Sharevalue" mySQL1 = mySQL1 & " WHERE coden = " & Me.coden Debug.Print mySQL1 Set rst1 = CurrentDb.OpenRecordset(mySQL1) rst1.MoveLast For i = Me.coden To Me.coden rst1.Edit rst1!amount = rst1!amount + X1 rst1.Update Form_datac.Sharevalue.Requery Next i توزيع المبلغ بشرط.rar تحياتي

جرب هذا الكود وترى النتيجة في Sheet2 Option Explicit Sub Split_names() Dim rg As Range Dim i%, Str Sheets("sheet2").Range("B2").CurrentRegion.Clear Set rg = Sheets("sheet1").Range("B2").CurrentRegion For i = 1 To rg.Cells.Count Str = rg.Columns(1).Cells(i) Str = Split(Str, "|") Sheets("sheet2").Cells(i + 1, 2) _ .Resize(, UBound(Str) + 1) = Str Next Sheets("sheet2").Range("B2"). _ CurrentRegion.Columns.AutoFit End Sub الملف مرفق Split_names.xlsm

جرب هذا الكود Option Explicit Dim sh As Worksheet Dim Other_sh As Worksheet Dim Rg As Range Dim All_RG As Range Dim lc%, i%, Ro%, Arr(), itm '+++++++++++++++++++++++ Sub creat_shett() Set sh = Sheets("Sheet1") lc = sh.Cells(Rows.Count, 3).End(3).Row For Each Rg In sh.Range("C2:C" & lc) If Rg.Value <> "" Then If Not Application.Evaluate("ISREF('" & Rg.Value & "'!A1)") Then sh.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Rg.Value End If End If Next add_data End Sub Sub add_data() Set sh = Sheets("Sheet1") For Each Other_sh In Sheets If Other_sh.Name <> "Sheet1" Then ReDim Preserve Arr(i) Arr(i) = Other_sh.Name i = i + 1 End If Next For Each itm In Arr Set Other_sh = Sheets(itm) With Other_sh Set All_RG = .Range("A1").CurrentRegion Ro = All_RG.Rows.Count If Ro > 1 Then Set All_RG = All_RG.Offset(1).Resize(Ro - 1) All_RG.Clear End If .Range("Z1") = sh.Cells(1, 3) .Range("Z2") = .Name sh.Range("A1").CurrentRegion.AdvancedFilter 2, _ .Range("Z1:Z2"), .Range("A1:d1") .Range("Z1:Z2").Clear End With Next End Sub الملف مرفق Hasan_rady.xlsm

المشكلة في أن نطاق البحث غير متساوي في جميع المعادلات والصواب تكون البداية الصف 17 والنهاية الصف 172 فتكون مثلا المعادلة في f17 =INDEX(g!$C$17:$S$172,MATCH(1,(g!$C$17:$C$172='3'!C17)*(g!$D$17:$D$172='3'!D17)*(g!$E$17:$E$172='3'!E17),0),4) لأن بعض الخلابا تنتهي عند 216

بدايتك في تعديل المرجع الخاص بالاسم المعرف xxx الموجود في شيت data_validation بدلا من k10:k17 إلى k10:k20 ثم تضيف عناوين الاعمدة المطلوبة في مكانها في هذه القائمة

تسلم اخي أبو الحسن و شكراً لك على هذا العمل بس يا ريت ترفع نسخة عن مكتبتك لاني لا أحتفط بالأكواد التي أضعها (الا القليل منها) حتى يستفيد منها الأخرون

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

والنتيجة ستكون بصالح السائل يغلق الموضوع يمكنك انشاء موضوع جديد مراعيا قواعد المشاركة

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

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم empSalary.rar تحياتي

متشكر جدا على ردك لكن انا عايز الجمع يكون من اول يناير لحد شيت Month اي حتى شهر ابريل فقط وكل مره احرك شيت month يتم تعديل الجمع مره اخرى

وعليكم السلام - تفضل 1الارقام الطويلة.xlsm

كانت واجهتنى مثل هذه المشكله حيث قمت بتسطيب الاكسيل فقط من مجموعه الاوفيس فكانت تظهر مثل هذه المشكله فقمت بالغاء تسطيب الاكسيل واعاده تشغيل الجهاز وقمت بتسطيب مجموعه الاوفيس كامله فاشتغل بدون ادنى مشكله حاول تعمل كده وان شاء الله المشكله ستحل

وعليكم السلام-اهلا بك فى المنتدى , تفضل يمكنك جعل المعادلة هكذا =IF(OR(B3="",C3=""),"00:00",(C3+0.5-B3)) إبراهيم الخلية الفارغة1.xls

اذا كان برنامجك لايتطلب الاتصال بالانترنت فاستخدم الطريقة التي اعلاه وهي الحماية عن طريق اسم المعالج ورقم الـ uuid

السلام عليكم دالة استخراج اسم ولي الامر كاملا او الاسم الاول مفردا Option Explicit ' بسم الله الرحمن الرحيم " ' ******************** " ' دالة استخراج اسم ولي الأمر " '========================================" ' True = kh_First اذا كان " ' او اي رقم غير الصفر " ' تقوم باستخراج الاسم الاول " '========================================" ' يامكانية معالجة الاسم المركب الاول " ' تلقائياً حسب معايير معرفة لديها " ' Kh_Father_Replace في الدالة " ' ويمكنك اضافة اي معيار آخر " ' بجانب المعايير الموجودة " ' MyArray في المتغير " ' مع مراعاة وجود فراغ بداية ' او نهاية المعيار '========================================" '----------------------------------------------------------------- Function Kh_Father_Name(ByVal Name As String, Optional kh_First As Boolean) As String Dim KhString As String, Kh_Mid As String, Kh_Rep As String Dim KhMyNo As Integer On Error GoTo Err_Kh_Father_Name If IsEmpty(Name) Then GoTo Err_Kh_Father_Name KhString = Kh_Father_Replace(Trim(Name)) & " " KhMyNo = InStr(1, KhString, " ", 1) If kh_First Then Kh_Mid = Trim(Mid(KhString, 1, KhMyNo)) Else _ Kh_Mid = Trim(Mid(KhString, KhMyNo, Len(KhString))) Kh_Rep = Replace(Kh_Mid, "^", " ") Kh_Father_Name = Kh_Rep Exit Function Err_Kh_Father_Name: Kh_Father_Name = "" End Function Private Function Kh_Father_Replace(ByVal Kh_Sub As String) As String Dim MyArray, Ar Dim Sn As String, Re As String '==================================================== ' يمكنك اضافة اي معيار آخر هنا بجانب المعايير الموجودة MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله" _ , " الدين", " الإسلام", " الاسلام", " الحق") '==================================================== Sn = Kh_Sub For Each Ar In MyArray Re = Replace(Ar, " ", "^") Sn = Replace(Sn, Ar, Re) Next Kh_Father_Replace = Sn End Function خبور خير استخراج اسم ولي الامر كاملا او الاسم الاول مفردا.rar