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

يمكن كذلك ربط الاكسس بـ SQL Server عن طريق ODBC وتكون الجداول مربوطة بواجهة الاكسس ، وتستعمل الاكسس بطريقة عادية : . جعفر

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

عند كتابة رقم الشيت يقتصر البحث في الشيت المكتوب فقط Updated Sub Test() Dim lr1, lr2 Dim i Application.ScreenUpdating = False Cells(5, 1).CurrentRegion.Offset(1).ClearContents For i = IIf(Range("m3") = "", 1, Range("m3")) To IIf(Range("m3") = "", Sheets.Count, Range("m3")) If Range("m3") <> "" Then i = Range("m3").Value + 1 If Sheets(i).Name <> "ÇáÈÍË" Then lr1 = Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets(Sheets(i).Name).Range("A3:L1800").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A2:L3"), CopyToRange:=Range("A" & lr1 & ":L" & lr1) Cells(lr1, 1).Resize(, 12).Delete lr2 = Cells(Rows.Count, 1).End(xlUp).Row + 1 If lr1 <> lr2 Then Range(Range("a" & lr1), Range("a" & lr1).End(xlDown)).Offset(, 12) = Sheets(i).Name End If: End If Next Range("I10").Select Application.ScreenUpdating = True End Sub

للمرة الالف عدم نسمية الورقة باللغة العربية جرب هذا الماكرو صفحة Salim من هذا الملف Option Explicit Sub del_data() Dim Ar(), Element Dim Rg_To_copy As Variant Dim My_sh As Worksheet Dim Dic As Object, KY, i% Set My_sh = Sheets("Salim") Ar = Array("B8", "B47") Set Dic = CreateObject("Scripting.Dictionary") For Each Element In Ar For Each Rg In My_sh.Range(Element).Resize(30) _ .SpecialCells(2, 23) Rg_To_copy = Application.Transpose(Rg.Resize(, 7)) Rg_To_copy = Application.Transpose(Rg_To_copy) Dic(Dic.Count) = Join(Rg_To_copy, "*") Next My_sh.Range(Element).Resize(30, 7).ClearContents If Dic.Count Then For i = 0 To Dic.Count - 1 My_sh.Range(Element).Cells(1, 1). _ Resize(, 7).Offset(i) = Split(Dic.Item(i), "*") Next End If Dic.RemoveAll Next Element End Sub الملف مرفق Osama_Dict.xlsm

Import Data from oracle Report.zip

هناك قاعدة حاول تستحضرها عند تطوير أي برنامج القاعدة تقول : أن كل ما يمكن الحصول عليه بالحساب لا داعي لتخزينه/حفظه فناتج الفرق وحالة الحضور/سبب التأخير لاداعي لتخزينهما. وكذلك الوقت الإفتراضي إذا كان ثابتا وهو وقت وحيد لجميع الموظفين فلا داعي أيضا لتخزينه. يعني يكفي حفظ وقت الحضور فقط وحذف الباقي ويمكن الحصول على النتائج من خلال استعلام.

سألني صديق عن اعداد ماكرو يساعده فى توفير وقت عدة جمل يحتاج لكتابتها كثيرا فى الوورد واول ما خطر ببالي أن أبدأ كما طلب فى كتابة بعض الاكود، و تطرق ذهني أيضا لاعداد نموذج يحوي الجمل المتكررة، ليختار منه و لكن بفضل الله تذكرت حل يعرفه الكثير ، و لكن ربما لا يستخدمه الكثير، فاحببت مشاركتكم به ساضيف حلان الاول فى هذه المشاركة يخص الاستبدال الالى دون تدخل منك و الثاني ساضيفه فى مشاركة تالية هنا فى نفس الموضوع يخص الاستبدال يدويا اولا الاستبدال الالي فعلى سبيل المثال مثلا بدلا من كتابة جملة "هذا للعلم و اتخاذ ما ترونه مناسباً من إجراءات مناسبة، مع وافر الشكر و التقدير" اريد ان اختصر كتابتها على سبيل المثال ، و عليه فاختار كلمة لا تحتاج كتبتها كثيرة و يحبذ كونها مزيج من كلمة و حرف مثلا نختار هنا هذ1 لنكتبها كمفتاح للحصول على الجملة أو أي عبارة يسهل عليك استخدامها على الا تكون عبارة يتوقع استخدامها فى الكتابة العادية. مع ملاحظة أن الحد الاقصى لعدد حروف الجملة هو 255 حرف و الخطوات كالتالي: File Options ثم اتباع الخطوات التالية: 1- Proofing 2- Auto correct 3- نكتب هنا هذ1 4- نكتب الجملة الكاملة : "هذا للعلم و اتخاذ ما ترونه مناسباً من إجراءات مناسبة، مع وافر الشكر و التقدير" 5-add و نكرر ذلك لما نرغب من حالات ثم 6- ok و الان فى الوورد اذا كتبت هذ1 يليها مسافة أو Enter ستستبدل اليا ب "هذا للعلم و اتخاذ ما ترونه مناسباً من إجراءات مناسبة، مع وافر الشكر و التقدير" و هذا طبعا يوضح لماذا اخترنا جملة عبارة غير معتادة مثل هذ1 حتي لا يتم عمل استبدالات غير مرعوب بها اذا اخترنا جملة عادية و في المشاركة التالية ساضيف الطريقة الثانية

حياك الله 🙂 كلامي هنا عن تكرار البصمة بدون فاصل: وبما انك لم ترد علينا بإمكانية استعمال صيغة accdb ، والتي بها نستطيع التحكم في الوقت الفاصل بين البصمة والاخرى ، لذا سأعطيك استعلام حذف البيانات الاضافية والذي عملت عليه سابقا: . 1. الاستعلام الذي يعطيك اول قيمة (الدخول T_Min) وآخر قيمة لليوم (الخروج T_Max) ، . 2. نفس بيانات الجدول CHECKINOUT ، ولكن بإضافة حقل للتاريخ ، ولا نستخدمه مباشرة ، وانما استعلام الحذف التالي يستعمله ، . 3. استعلام الحذف : . وقوته في المعيار ليحصر لبيانات المتكررة: Between (SELECT top 1 DateAdd('s','1',[CHECKTIME]) FROM CHECKINOUT As C WHERE C.USERID= [qry_InOut].[USERID] And DateSerial(Year(C.[CHECKTIME]),Month(C.[CHECKTIME]),Day(C.[CHECKTIME]))=[qry_InOut].[D] ORDER BY [CHECKTIME]) And (SELECT TOP 1 DateAdd('s','-1',[CHECKTIME]) FROM CHECKINOUT As C WHERE C.USERID= [qry_InOut].[USERID] And DateSerial(Year(C.[CHECKTIME]),Month(C.[CHECKTIME]),Day(C.[CHECKTIME]))=[qry_InOut].[D] ORDER BY [CHECKTIME] DESC) جعفر 1356.1.att2000.accdb.zip

السلام عليكم اخي الكريم ، انت السبب بعدم حصولك على اجابة كيف ؟ كان الأولى بك من البداية ان ترفق اكوادك هذه داخل المرفق ، ومن خلال النموذج تظهر النتائج ويطلع عليها من يريد تقديم المساعدة يعني يجب ان تكون بمثابة الطاقم الطبي الذي يعد المريض لمشرط الجراح

الحل بواسطة المعادلات ليس سهلاُ لوجود الخلايا المدمجة ارفقي ملفاُ بسيطاً 5 أو 6 أسماء مع النتائج المتوقعة (لبس جدول اكثر من نصفه فارغ)

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

وعليكم السلام-يمكنك استخدام هذه المعادلة =SUMPRODUCT((WEEKDAY($A$2:$A$32,2)<>6)*(WEEKDAY($A$2:$A$32,2)<>7)*(B2:B32="")) مثال1.xlsx

انا اخبركم مشكلتكم ، والوسيلة التي قد استخدمها اخوي أبو إبراهيم (انظر للصورة ادناه) : اذا فتحت ملف txt مباشرة عن طريق برنامج Notepad ، فستجد بيانات غير مرتبه ، بينما اذا استعملت برنامج متخصص لقراءة نصوص البرمجة ، مثل البرنامج المجاني ++Notepad ، فسترى انه يعطيك المعلومات المطلوبة 🙂 . والسؤال هنا ، ولإثراء الموضوع ، يا ترى اي برنامج استعمل اخونا أبو إيراهيم لفك هذا الطلسم 🙂 جعفر

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

what about Sub Test() Dim lr1, lr2 Dim i Application.ScreenUpdating = False Cells(5, 1).CurrentRegion.Offset(1).ClearContents For i = IIf(Range("m3") = "", 1, Range("m3")) To IIf(Range("m3") = "", Sheets.Count, Range("m3")) If Sheets(i).Name <> "ÇáÈÍË" Then lr1 = Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets(Sheets(i).Name).Range("A3:L1800").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A2:L3"), CopyToRange:=Range("A" & lr1 & ":L" & lr1) Cells(lr1, 1).Resize(, 12).Delete lr2 = Cells(Rows.Count, 1).End(xlUp).Row + 1 If lr1 <> lr2 Then Range(Range("a" & lr1), Range("a" & lr1).End(xlDown)).Offset(, 12) = Sheets(i).Name End If: End If Next Range("I10").Select Application.ScreenUpdating = True End Sub

رجاء تعطيني الخطوات بالضبط ، وباسماء الحقول ، لأني حاولت وما صار شيء !! جعفر

وعليكم السلام 🙂 الـ Recordset معناه جلب البيانات من الجدول وتخزينها في الذاكرة المؤقتة Ram (وهنا يجب ان يكون كمبيوتر المستخدم فيه كمية كافية لهذه الاضافة) ، وهذا يأخذ وقتا ، ولكنه بعد ذلك يصبح سريع ، لأن جلب البيانات يكون اسرع ، بينما لو استعملت وحدة التخزين SSD ، فلن تلاحظ فرق كبير بين الطريقة العادية وطريقة Recordset ، ولتجعل الطريقتين اسرع ، يجب ان تعمل فهرسة للحقول التي فيها فرز/تصفية (ثم ضغط واصلاح) ، ولما تستعمل LinkChildFields ، فهذا الحقل يحتاج الى فهرسة (لأنه تصفية 🙂 ) . جعفر

أعتذر عن هذا الخطأ Import Data from oracle Report.zip

أهلا بك.. أنت تريد استيراد البيانات بطريقة منسقة كما في الجدول! الملف النصي عبارة عن مسردات أوامر صرف.. وبناءً عليه: هناك بيانات رأسية تمثل بيانات أمر الصرف، وهناك بيانات تفصيلية تمثل بنود أمر الصرف.. على هذا الأساس قمت بإنشاء جدول جديد لأوامر الصرف يدعم جدول البيانات التفصيلة المرفق بمثالك حتى لا تتكرر البيانات في جدول واحد.. أرجو أن يكون هذا التحسين مرضيا لك؟ وإلا أرجعت لك البيانات في جدول واحد.. Import Data from oracle Report.zip

ربما ينفع هذا الماكرو Option Explicit Sub My_macro() Dim D As Worksheet, RO_A%, i%, m% Dim T As Worksheet Dim arr(), it, MX, Cret, ky Dim Dic As Object Set D = Sheets("DATA") Set T = Sheets("TEST") RO_A = D.Cells(Rows.Count, 1).End(3).Row arr = Array("A", "B", "C") For Each it In arr Set Dic = CreateObject("Scripting.Dictionary") For i = 2 To RO_A If D.Cells(i, 1) = it Then Dic(D.Cells(i, 4).Value) = _ Dic(D.Cells(i, 4).Value) + Val(D.Cells(i, 3)) End If Next i MX = Application.Max(Dic.Items) For Each ky In Dic.Keys If Dic.Item(ky) = MX Then Cret = ky Exit For End If Next ky T.Cells(m + 2, "E") = Cret m = m + 1 Dic.RemoveAll Next it Set D = Nothing: Set T = Nothing Erase arr: Set Dic = Nothing End Sub الملف مرفق Hashem_Dict.xlsm

لا أعلم اذا كان هذا المطلوب Dates.xlsx