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

جرب هذا الملف فقط اضغط الزر Run الكود Option Explicit Rem code for Extact Number_From_Text Sub Extract_Number_Please() Dim rgx As Object Dim My_Number As Object Dim ws As Worksheet Dim i%, m%, k%, x%, Ro% Dim My_sum#, Big_sum# Set rgx = CreateObject("VBScript.RegExp") Set ws = Worksheets("Salim") Ro = ws.Cells(Rows.Count, 2).End(3).Row m = 2: k = 4 ws.Cells(m, k).CurrentRegion.Clear With rgx .Global = True: .Pattern = "(\d+\.?\d+)" For i = 2 To Ro If .Test(ws.Cells(i, 2)) Then Set My_Number = .Execute(ws.Cells(i, 2)) For x = 0 To My_Number.Count - 1 My_sum = My_sum + Val(My_Number.Item(x)) Next x End If Big_sum = Big_sum + My_sum ws.Cells(m, k) = My_sum My_sum = 0 m = m + 1 Next i End With ws.Cells(m, k) = Big_sum With ws.Cells(2, k).Resize(m - 1) .HorizontalAlignment = 3 .VerticalAlignment = 2 .Borders.LineStyle = 1 .Font.Bold = True End With Set rgx = Nothing: Set ws = Nothing Set My_Number = Nothing End Sub الملف مرفق ahmed_atoon.xlsm

السلام عليكم و رحمة الله تعالى و بركاته استخدم الكود التالي سوف يعطيك أسماء جميع الأزرار Dim frm As Form Dim fc As Control Set frm = Me For Each fc In frm.Controls If fc.ControlType = 104 Then MsgBox (fc.Name) End If Next fc Set frm = Nothing

انظر المرفق ووافينا بالنتيجة --------------->>>>>> moh-2.rar

إليك تلوين.xlsm

السلام عليكم مشاركة مع اساتذتي الاعزاء تفضل هذه المحاولة ارجو ان تكون طلبك ملاحظة : شغل المايكرو لتشغيل الكود وهو معد لتغيير خلفية جميع النماذج المفردة في قاعدة البيانات BackGround.rar

اجعل المعادلة هكذا =IFERROR(INDEX($A$2:$A$200,SMALL(IF($D$2:$D$200=$H$2,IF($E$2:$E$200=$I$2,IF($F$2:$F$200=$J$2,ROW(A$2:A$200)-ROW(A$2)+1))),ROWS($I$5:I5))),"") 3قوائم.xlsx

السلام عليكم من رخصة استاذي العزيز صالح حمادي تفضل استاذ Ahmed.IQ التعديل علما ان التعديل جرى على نفس كود استاذ صالح Dim frm As Form Dim fc As Control Dim RowData As String Set frm = Me RowData = "" For Each fc In frm.Controls If fc.ControlType = 104 Then RowData = RowData & "," & fc.Name End If Next fc Me.Comb1.RowSource = Right(RowData, Len(RowData) - 1) Set frm = Nothing ملاحظة : Row Source Type = Value List

بارك الله بجهودك استاذ ابا جودي وازادك الله علما وتقوى نعم هذا هو المطلوب شكراً جزيلاً

فكرة بسرعة New.accdb

السلام عليكم 🙂 تفضل 🙂 . واستعمل الاستعلام qry_Group_Shifts_by_Dates كمصدر بيانات ، وتقدر تعمل به التقرير او النموذج الذي تشاء. جعفر 1281.4.FRm_Refresh.accdb.zip

السلام عليكم ورحمة الله ضع المعادلة التالية قى الخلية "" =COUNTIFS($B$3:$B$5000;"السادس ";$C$3:$C$5000;$G3;$D$3:$D$5000;"أ") اما المعادلة التالية فضعها فى الخلية "" =COUNTIFS($B$3:$B$5000;"السادس ";$C$3:$C$5000;$G3;$D$3:$D$5000;"ب") ثم اسحب المعادلتين الى اخر خلية تريدها قم بتغيير اسم الصف فى كل جدول هذا و بالله التوفيق عفوا الخلية الاولى " H3 " و الخلية الثانية " I3 " حساب أعداد الطلاب حسب ثلاث قيم.xlsx

بالنسبة للموضوع الأول هناك اشياء موصوعة الــ "GB" أظن "Gega byte" و أشياء موضوعة بالـــ "TB" "Terra Byte" في هذا الكود يتم الجمع على اساس الــ "GB" كل "TB" = مليون "GB" حسب نا أغتقد اذا كان خطأ استبدل في الماكرو الرقم مليون (Const Multp) الى الرقم الذي تعتقده صحيحاً الكود لهذا الأمر يتم التنفيذ في العامود (F) Option Explicit Sub test_For_TB() '+++++++++++++++++++++ Dim ws As Worksheet Dim ro%, Sm#, Big_Sm#, x%, k% Dim My_sum#, Big_sum# Dim arr Const Multp = 1000000 '++++++++++++++++++++++ Set ws = Worksheets("Salim") ro = ws.Cells(Rows.Count, 2).End(3).Row ws.Cells(2, 6).CurrentRegion.Clear For x = 2 To ro arr = Replace(ws.Range("b" & x), Chr(32), " ") arr = Replace(arr, Chr(10), " ") arr = Split(arr, " ") For k = 0 To UBound(arr) - 1 Step 2 If UCase(arr(k + 1)) = "TB" Then Sm = Sm + arr(k) * Multp Else Sm = Sm + arr(k) * 1 End If Next k Big_Sm = Big_Sm + Sm ws.Range("F" & x) = Sm Sm = 0 Next x Range("F" & ro + 1) = Big_Sm With ws.Range("F2").Resize(ro) .HorizontalAlignment = 3 .VerticalAlignment = 2 .Borders.LineStyle = 1 .Font.Bold = True .NumberFormat = "#,##0" End With End Sub الملف من جديد مع الكود الجديد والقديم بنفس الوقت ahmed_atoon_TB.xlsm

تفضلي الملف به 3 شيتات بــ 3 طرق اول شيت عن طريق موديول VBA والتاني مصفوفه والثالث معادله SUM.xlsx

للاسف ليس هناك دالة لهذا الامر(حسب علمي) لأن الدالة sum تتجاهل الخلية (بالكامل) التي تحتوي على نص و ليس محتوباتها و ريثما تقوم مايكروسوف باختراع هكذا دالة ما علينا الا العمل بواسطة الــ VBA

تفضلى - كما بالملف طريقتين مختلفتين اختارى منها المناسب لك وهذه أيضاً دالة معرفة لنفس الطلب Function summm(rng) Dim arr ReDim arr(1 To rng.Cells.Count) For Each C In rng.Cells arr(x + 1) = f(C) x = x + 1 Next summm = WorksheetFunction.Sum(arr) End Function معادلةجمع مدى يحتوى على أرقام ونصوص sumarize number with text.xlsx

بالرغم من قدم تاريخ الموضوع وكان من الاولى فتح موضوع جديد ولكن ان شاء الله ابشر بالخير قم بانشاء موديول جديد وضع به هذه الاكواد Public Function OpenQry(QryNm As String, MyValue As Variant) TempVars.Add "x", MyValue.Value DoCmd.SetWarnings False DoCmd.OpenQuery (QryNm) DoCmd.SetWarnings True End Function على ان يتم استدعاءه من خلال السطر التالى من النموذج من خلال زر امر او من خلال اى حدث حسبما ترغب وتريد Call OpenQry("fi", Me!txtMyValue) ولابد من عمل مربع نص فى النموذج باسم txtMyValue وبهذه الطريقة سوف يتم فتح الاستعلام بتمرير القيمة المعلمة برمجيا اليه من خلال مربع النص وان كان هناك اكثر من استعلام يتم فقط تغير اسم الاستعلام بالسطر الاتى Call OpenQry("اسم الاستعلام", Me!اسم مربع النص فى النموذج والذى يحوى القيمة المعلمة) واخر خطوة وضع هذا السطر فى الاستعلام فى المعيار للحقل المطلوب تمرير القيمة المعلمة اليه [TempVars]![x]

جزاك الله خيرا رائع

السلام عليكم ورحمة الله وبركاته فيديو شرح احتراف تصميم يومية الحضور والانصراف بدالتى Weekday, CHOOSE واستخراج اسم اليوم من التاريخ تلقائيا وعمل فورمات لخلية محددة حسب تعبئة محددة ملف العمل.xlsx

وعليكم السلام -بارك الله فيك استاذنا الكريم .... عمل ممتاز جعله الله فى ميزان حسناتك ورحم الله والديك

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

واثراء للموضوع هذا حل اخر بالمعادلات نسخة من تلوين666.xlsm

ربما تستفيد من هذا غياب 7.rar

وعليكم السلام قم بانشاء ماكرو وقم بتسميته AutoKeys كما بالصوره ثم قم بانشاء ماكرو فرعى بداخله كما بالصوره واكتب به F^ جرب ووافنا بالنتيجه بالتوفيق اخى

اعتقد انه بالفلترة افضل من الحلقات التكرارية Sub cutpaste_Rows() Application.ScreenUpdating = False Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Set srcWS = Sheets("sheet1") Set desWS = Sheets("sheet2") With srcWS .Cells(6, 1).CurrentRegion.AutoFilter 3, Range("a2").Value .AutoFilter.Range.Offset(1).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) .AutoFilter.Range.Offset(1).EntireRow.Delete .Range("A1").AutoFilter End With Application.ScreenUpdating = True End Sub تلوين (1).xlsm

حبيبى استاذ سليم وهو فى استاذن معلم من تلميذه وهو بنتعلم منكم

بعد اذن الاستاذ وجيه لا استطيع الا أن أعطي ملاحظات لماذا لا نستغني عن الحلقة التكرارية (J) الثانية ؟؟ لأن الحلقات التكرارية ترهق البرنامج اذا كانت البيانات كبيرة و ذلك باعتماد هذا الكود Sub aa() Dim ws As Worksheet: Set ws = Sheets("Sheet1") Dim sh As Worksheet: Set sh = Sheets("Sheet2") sh.Range("a7:e55") = "" k = 7 lr = ws.Range("a" & Rows.Count).End(xlUp).Row For i = 7 To lr If ws.Range("b2") = ws.Range("c" & i) Then sh.Cells(k, 1).Resize(, 5).Value = _ ws.Range("A" & i).Resize(, 5).Value k = k + 1 End If Next sh.Activate End Sub

طبعاّ بعد اذن استاذنا الكبير إبراهيم ... بارك الله فيك كود ممتاز جعله الله فى ميزان حسناتك تفضل الأمر بسيط جداً ويمكنك تعديله بنفسك ... عليك بتعديل هذه الكلمة من كل الكود xlAscending الى xlDescending

وعليكم السلام-فقط يمكنك استخدام هذه المعادلة =SUBSTITUTE(A2," ","") رفع المسافة الواحدة بين الحرف والرقم.xlsm

انا كمان بتعلم والله وبقالي كتير بصمم ولسا بتعلم كمان الاكسس جميل جدا بس عايز تركيز وشغل صح اكيد حضرتك فيامكانية اضافة عملاء وحسابات زي ما تحبي عن طريق الجدول تضيفي رقم جديد غير مكرر والعميل او الحساب الجديد وجاري التعديل على اساس التاريح وحضرتك بس عرفيني بالمستحدات ربنا يوفقك يارا_2.rar

وعليكم السلام-عليك بإستبدال معادلتك بهذه المعادلة =IFERROR(INDEX($A$2:$A$200,SMALL(IF($D$2:$D$200=$G$2,IF($E$2:$E$200=$H$2,ROW(A$2:A$200)-ROW(A$2)+1)),ROWS($H$5:H5))),"") 1قوائم.xlsx

وعليكم السلام-تفضل شرح قائمة ديفولبر الرائعه Developer Form Controls In Excel Excel Form Control vs. ActiveX Control (7 Differences) Form controls VS Active X controls (Microsoft Excel Video Tutorial)

وعليكم السلام حيرتنى معاك لأن المعادلة الموجودة بالملف تعمل بكل كفاءة ....واذا أردت تغيير قيمة التقسيم يمكنك تغيير الأرقام الموجودة بداية من الخلية AB10 الى ما تشاء وتريد وشكرا

تفضل لك ما تريد ... هذا فيديو تعليمى لطلبك مقدم من الأستاذة ساجدة العزاوى لها منا كل المحبة والإحترام ج89 زر امر على اليوزرفورم لفتح ملف اكسل ملف ورد ملف pdf ساجدة العزاوي open word excel userform vba

تفضل goto the page with pass1.xls

كان عليك تنفيذ نصيحة استاذنا الكبير سليم .. ولكن بعد اذن استاذ سليم طبعاً يمكنك استخدام هذه الدالة المعرفة لذلك لعد الأرقام داخل الخلية الواحدة Function Mylen(Z As Range) Dim C As Long, Y As Long, A As Long, B As Variant A = 0 For C = 1 To Len(Z) B = Mid(Z, C, 1) For Y = 0 To 9 If Y = B Then A = A + 1 End If Next Next Mylen = A End Function ووضع هذه المعادلة بداية من الخلية D4 سحباً للأسفل =Mylen(F4) أو يمكنك بهذه المعادلة العادية .. وتلك الطريقتين موجودة بالملف =SUM(LEN(F4)-LEN(SUBSTITUTE(F4,{1,2,3,4,5,6,7,8,9,0},))) تسويات - 1.xlsm

أحسنت استاذ فتح وزادك الله من فضله

بارك الله فيك وزادك الله من فضله ورحم الله والديك

وعليكم السلام - تفضل اخى الكريم يمكنك عمل ذلك بهذه المعادلة ( معادلة مصفوفة) Ctrl+Shift+Enter =IF(COUNTIF($A$3:$A3,$A3)>1,"",MODE(IF($A$3:$A$900=$A3,$F$3:$F$900))) mode fun1.xlsx

تفضل Office 365 Excel in 15 Mints - شرح الإكسل فى 15 دقيقة للمبتدئين Office365 دورة شرح اوفيس 365 بطريقة سهلة office 365

وعليكم السلام-اجعل تنسيق الخلية هكذا ##"0."000"Kg" format cell1.xlsx

تفضل تم تعديل تنسيق التاريخ ويمكنك عمل ذلك بنفسك من خلال تتبع هذه الصورة TEST1.xlsx

السلام عليكم 🙂 وهذا شغل اخوي ابا جودي ، بس يأخذ اكثر من ملف دفعة واحدة (يعني تقدر تختار مجموعة ملفات ، ثم تضيف مجموعة اخرى الى القائمة ، دفعة واحدة) 🙂 تقدر بالفأرة تختار اكثر من ملف ، او عند طريق الضغط على الزر shift او ctrl اثناء النقر على اسماء الملفات 🙂 جعفر ImportExcel.accdb

السلام عليكم ورحمة الله وبركاته هل بالامكان مساعدتي في حل المشكلة

وعليكم السلام-تفضلى goto the page with pass1.xls

السلام عليكم جرب الملف التالي sum of mix cell.xlsx