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

وعليكم السلام-كان عليك إستخدام خاصية البحث بالمنتدى قبل رفع مشاركتك -تفضل طريقة توزيع رقم من خلية واحدة الى مجموعة خلايا وهذا كود أخر يمكنك أيضاً إستخدامه Sub SplitStuff() Dim Rng As Range Dim InputRng As Range, OutRng As Range xTitleId = "KutoolsforExcel" Set InputRng = Application.Selection Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8) Application.ScreenUpdating = False For Each Rng In InputRng xValue = Rng.Value xRow = Rng.Row For i = 1 To VBA.Len(xValue) OutRng.Cells(xRow, i).Value = VBA.Mid(xValue, i, 1) Next Next Application.ScreenUpdating = True End Sub أو يمكنك أيضاً استخدام هذه المعادلة اذا كان الرقم القومى مثلاً موجود بالخلية A1 =MID($A1,COLUMNS($A$1:A$1),1)

وعليكم السلام-عليك بإستخدام هذا الكود Sub run() Range("a65536").End(xlUp).Select End Sub الذهاب الى اخر صف مكتوب.xlsm

ان قمت بالتدقيق فى الرابط الذى رفعته لك لوجدت طلبك به وهذه هى المعادلة المطلوبة =IFERROR(MID($A3,LEN($A3)-(COLUMNS($B2:B2)-1),1),0)+0 فصل الرقم القومى1.xlsm

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

وعليكم السلام-يمكنك استخدام هذه المعادلة =IFERROR($G3*VLOOKUP($A3,'نسب العمولة'!$D$3:$G$800,2,0),"") Test1.xlsx

فقط يمكنك استخدام هذه المعادلة لتلبية طلبك فأول جزء المعادلة هو lookup ثم فتح القوس وكتابة الرقم 1 ثم علامة ثم 0 وهذا كود ثابت بالمعادلة ثم علامة / وكتابة الجزء الخاص بالبحث بالعمود الأول بالصفحة التى تريد جلب البيانات منها ثم الجزء الأخر بالمعادلة وهو Offset ثم ذكر رقم الخلية التى نود البحث من خلالها وأخيراً الجزء الأخير من المعادلة وهو ذكر العمود الثانى من الصفحة التى نريد جلب البيانات منها وهى النتيجة التى نريد اظهارها بالمعادلة =IFERROR(LOOKUP(1,0/MATCH("*"&Sheet2!$A$1:$A$45&"*",OFFSET(C69,,,COUNTIF(F:F,F69)),0),Sheet2!$B$1:$B$45),"") New Microsoft Excel 97-2003 Worksheet.xls

Dim rst As Recordset Set rst = Me.RecordsetClone rst.MoveFirst Do Until rst.EOF If rst![رقم العملية] = Me![T4] Then MsgBox " السجل مكرر ", , " تنبيه" Me.Undo DoCmd.CancelEvent Exit Do End If rst.MoveNext Loop rst.Close F05.rar

تفضل -يمكنك استخدام هذه المعادلة مع ضبط تنسيق الخلايا =INT(E6/100)/24+MOD(E6,100)/1440 وهناك أيضاً معادلة ثانية ولكن طويلة =IF(LEN($E6)=3,LEFT(E6,1)&":"&RIGHT(E6,2),LEFT(E6,2)&":"&RIGHT(E6,2)) &" " & TEXT(IF(LEN($E6)=3,LEFT(E6,1)&":"&RIGHT(E6,2),LEFT(E6,2)&":"&RIGHT(E6,2)),"am/pm") وهذه معادلة ثالثة مع ضبط التنسيق أيضاً =--TEXT(E6,"00\:00") export - 1.xls

تفضل بإستخدام هذه المعادلة وعليك بإستكمال هذا على نفس الطريقة =IFERROR(VLOOKUP(C$8,Sheet2!$G$2:$I$380,2,0),"") 1a.xlsx

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

وعليكم السلام-بعد اذن الأستاذ سليم ولإثراء الموضوع ,تفضل تم عمل معادلة مصفوفة لطلبك (Ctrl+Shift+Enter) ... كما تم عمل قائمة منسدلة بالخلية B1 لتسهيل العمل لك لإختيار بدلاً من الكتابة لتقليل الأخطاء =IFERROR(INDEX(رئيسية!$B$2:$B$140,SMALL(IF(رئيسية!$C$2:$C$140=$B$1,ROW(A$2:A$140)-ROW(A$2)+1),ROWS($A$3:A3))),"") GOING1.xlsx

وعليكم السلام يمكنك استخدام هذه المعادلة-معادلة مصفوفة (Ctrl+Shift+Enter) IF(AND(A$19<>$A$1:$U$1,A$19<>$A$9:$U$9),"غير موجود",IFERROR(HLOOKUP(A$19,$A$1:$U$3,2,0),HLOOKUP(A$19,$A$9:$U$11,2,0))) دمج1.xlsx

وعليكم السلام-يمكنك استخدام هذه المعادلة =COUNTIF(A3:AC3,"ح")+COUNTIF(A3:AC3,"ج")+COUNTIF(A3:AC3,"ق") مجموع الأحرف1.xlsm

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

تفضل يمكنك استخدام هذه المعادلة لطلبك =IF($E52="","",IF(AND($D52>$H52,$H52<>0),"سداد جزئى",IF($D52=$H52,"سداد كلى",0))) مثال1.xlsx

وعليكم السلام-حاول إضافة هذا السطر بالكود بعد السطر الذى تحدث به المشكلة Sheets("Sheet1").Protect UserInterfaceOnly:=True جلب الاسماء من عدة شيتات مع عدم التكرار1.xlsm

أكرمك الله استاذ محمد وجعلك ممن يستمعون القول فيتبعون أحسنه - بارك الله فيك

وعليكم السلام-بكل بساطة يمكنك استخدام هذه المعادلة لطلبك وزيادة عن ذلك تم عمل قائمة منسدلة لأسماء الطلاب لتسهيل الإختيار بدل من الكتابة =IFERROR(VLOOKUP($D4,ورقة1!$D$4:$F$600,3,0),"") 1استدعاء.xlsx

وذلك من خلال هذه المعادلة =TRIM(MID(SUBSTITUTE(";"&$A3,";",REPT(" ",50)),COLUMN(A1)*50,50)) PAVARC.xlsm

كود رائع جدا استاذ سليم بارك الله فيك وجزاك كل خير

بالاضافه الى ما وجهك اليه اخى ومعلمى العزيز ابوخليل جزاه الله عنا كل خير قم بتعديل السطر الاول من الكود الى Dim rst As dao.Recordset بالتوفيق

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

افتح محرر الاكواد ثم من الشريط العلوي انقر على tools ثم اختر references قارن بين المكتبات المفعلة ( في الجهازين ) عليك اضافة المكتبة الناقصة ان وجدت ، أو تعديل الاصدار ان كان الموجود قديما وللمزيد ابحث في حقل قوقل من صفحة المنتدى عن tools references ستجد الكثير من الشرح

شكرا جزيلا استاذنا الفاضل جزاك الله كل خير

وفقكم الله

سلمت يداك اخى الكبير حسين مأمون و اسف على الازعاج

Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("n2:p1000000")) Is Nothing Then 'ÇÐÇ Êã ÊÍÏíÏ Çí ÎáíÉ Ýí ÇáãÏì ÇáãÐßæÑ äÝÏ ÇáÓØÑ ÇáÊÇáí Target.Offset(, 1).Select 'ÇÒÇÍÉ ãÞÏÇÑ 1 ãä ÇáÎáíÉ ÇáãÍÏÏÉ End If End Sub يمكنك اضافة اعمدة اخرى باستعمال Elseifمبيعات كانليمون جاردن 8.xlsm

تفضل تعديل فاتورة (1).xlsm

جرب الكود التالي لزر أمر معاينة التقرير بعد تنفيد الفرز المطلوب جرب الكود التالي If Me.Filter = "" Then MsgBox "الرجاء تحديد معيير الفرز" Else DoCmd.OpenReport "تقرير مساحات Amount", acViewReport, , Me.Filter End If

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

المعادلة كما في الصورة الملف مرفق Ala3.xlsx

السلام عليكم ورحمة الله ضع المعادلة التالية فى اول خلية ثم اضغط Ctrl + Shift + Enter ثم اسحب المعادلة افقيا و رأسيا =IFERROR(INDEX(البيانات!$B$686:$I$712;MATCH(($B2&"*?");البيانات!$B$686:$B$712&البيانات!C$686:C$712;0);COLUMN()-1);"")

تفضل يمكنك هذا بهذه المعادلة =IFERROR(INDEX(البيانات!$C$2:$F$11,MATCH($B2,البيانات!$B$2:$B$11,0),MATCH(C$1,البيانات!$C$1:$F$1,0)),"") تقرير1.xlsx

السلام عليكم وذلك من خلال هذه المعادلة بداية من الخلية P2 =IFERROR(INDEX($A$2:$A$550,AGGREGATE(15,6,ROW($A$1:$A$302)/(MATCH($A$2:$A$550&$B$2:$B$550&$C$2:$C$550,$A$2:$A$550&$B$2:$B$550&$C$2:$C$550,0)=ROW($A$1:$A$302)),ROWS($2:2))),"") Book2.xlsx

تفضل يمكنك استخدام هذا الكود Sub AddBlankRows() Dim iRow As Integer, iCol As Integer Dim oRng As Range Set oRng = Range("b1") iRow = oRng.Row iCol = oRng.Column Do If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown iRow = iRow + 2 Else iRow = iRow + 1 End If Loop While Not Cells(iRow, iCol).Text = "" End Sub MM.xlsm

وعليكم السلام-لابد وان تكون المعادلة هكذا ="@"&INDEX(SheetNames,ROW()-1) ومن ثم فعليك إضافة هذه العلامة @ لكل أسماء صفحات الملف حتى تعمل معادلة Indirect بكفاءة

وعليكم السلام-تفضل لك ما طلبت ـ تــم ترجمة ملفك الأرباح والخسائر.xls

اضغط زر حفظ نسخة وانظر شيت 1 كانت فاتورة سعيد واضفنا عبد السلام ثم قمنا بحفظ نسخة وفي شيت1 تم ترحيل اسم الفاتورة ايضا

السلام عليكم كما وعدتكم .......... البرنامج جاهز ,,, وهو حسب نظام المملكة الاردنية الهاشمية تستطيعون التعديل عليه بما يتناسب مع منطقتكم من حيث الاسماء والاضافات البرنامج مفتوح المصدر وهو من تصميمي للتواصل والاستفسار عبر الواتس اب 00962787787573 اتمنى لكم الفائدة برنامج المحامي 2019 - Copy.rar

وهنا المزيد المزيد ،،،، سأقوم بوضع برامج بشكل يومي وبشكل كبير ، ، ، بس أهم شي زي ما وصيتكم الردود و الدعاء accarch154.zip accarch161.zip

السلام عليكم ورحمة الله وبركاته أخي العزيز اليكم كود معرفة اول وآخر يوم في الشهر ( بالميلادي ) StartDate = CDate("1/" & DatePart("m", mydate) & "/" & DatePart("yyyy", mydate)) enddate = DateAdd("d", -1, DateAdd("m", 1, StartDate)) Date_Code.zip

مشكووووووور وجزاك الله خير

استخدم الداله DateAdd على الشكل التالي NewDate=DateAdd("d",5,"IssueDate") حيث IssueDate هي تاريخ الاصدار 5 عدد الأيام المطلوب اضافتها

السلام عليكم ورحمة الله وبركاتة السؤال الاول كيف يحدد عدد الايام تاريخ النهاية مثل تاريخ الاصدار 10/5/2005 وعدد الايام خمسة (5) يعني عدد الصلاحية او النهاية والبرنامج يوضع تاريخ النهاية اللى هي 14/5/2005 السؤال الثاني تحديد مده التصريح من 1الى 14 يوم اكثر مده وغير هذا مايقبله البرنامج ولكم مني جزيل الشكر

السلام عليكم Sub Test() Dim mm As Byte Dim yy As Integer mm = 12 yy = 1424 '-- للحصول على تاريخ نهاية الشهر هجري أو ميلادي MsgBox CDate(DateSerial(yy, mm + 1, 1) - 1) '-- للحصول على طول الشهر هجري أو ميلادي MsgBox Day(DateSerial(yy, mm + 1, 1) - 1) End Sub تحياتي .

السلام عليكم بعد الأستعانة بالله توصلت إلى هذه الكود اللي على قد الحال t0 = Year(Now) & "/" & Month(Now) & "/" & 1 t00 = Year(Now) & "/" & Month(Now) & "/" & 30 حيث أن t0 مربع النص الأول و t00مربع النص الثاني

كود للأخ فيصل الحربي : :d لقياس سرعة فتح التقارير ضع الكود التالي في حدث عند الفتح للتقرير ويجب عليك تغيير اسم التقرير بدلا من YourReportName dim dtStart as date dim dtStop as date dtStart = Now() docmd.openreport "YourReportName" dtStop = Now() msgbox "Time to open: " & dtStop-dtStart

Function THISWEEK(MYDATE) As Boolean If IsNull(MYDATE) Then THISWEEK = FLASE Exit Function End If Dim checkday As Byte, startdate As Date, enddate As Date checkday = Weekday(MYDATE, 1) If checkday = 7 Then checkday = 0 startdate = MYDATE - checkday enddate = startdate + 6 'MsgBox startdate 'MsgBox ENDDATE If ((startdate <= Now()) And (enddate >= Now())) Then THISWEEK = True Else THISWEEK = False End If End Function Function Myweekday(MYDATE As Date) Dim checkday As Byte checkday = Weekday(MYDATE, 1) If checkday = 7 Then checkday = 0 Myweekday = checkday End Function الموضوع فى الاكسيل ، مع مثال

برنامج Access kit هو برنامج يقوم باصلاح قواعد البيانات المعطوبة والتي يكون بها مشكله . يمكن التعامل معه بسهولة وهو باستيراد قاعدة البيانات اليه . للعلم انه نسخه مجانيه بالكامل ويقوم باصلاح اي اصدار من قواعد بيانات اكسس سواء اكسس97 او اكسس 2000 او اكسس2002 حجمه حوالي من 650 الى 700 ميجا بايت

من باب الإضافة يوجد أيضا برنامج أخر يسمى Access FIX 3.56 يقوم بإصلاح قواعد أكسيس المعموله على إصدارات 95 و 97 و 2000 ويستعيد الجداول المعطوبة حتى ولو كانت القاعدة محمية بكلمة مرور . يمكن إنزال نسخه منه Demo للتجربه من الرابط التالي : http://www.accessfix.com/download/afixdemo.exe أو من هنا : http://www.cimaware.arrakis.es/download/afixdemo.exe وهو من إنتاج شركة Cim AWare وحجمه 2.02MB http://www.cimaware.com/accessfix.html