الـعيدروس

حاليا حملت الملف من المشاركة ويعمل بصورة طبيعيه ؟ لاتنسى تفك الضغط عن الملف

عندي شغال الكود شاهد المرفق إنسخ الكود مره اخرى في المشاركة السابقة تم التعديل عليه كود.rar

السلام عليكم أو هكذا لخصنا المعادلة وتأدي نفس الغرض إنشئ مودويل وإلصق الدالة المركبة التاليه إستدعيها من الخلية "M9" وإسحب للاسفل بالشكل التالي =Ali_Cnt(D9:L9) '********************************* ' عدد المقاعد Private Const Mxn As Integer = 31 '********************************* Public Function Ali_Cnt(Arn As Range) As Integer Dim Rng As Range Dim i%, C&, j# Application.Volatile On Error Resume Next Set Rng = Range("D9:L50000") For i = 1 To Mxn j = Application.Large(Rng, i) If Application.CountIf(Arn, j) = 1 Then C = C + 1 Next i On Error GoTo 0 If C Then Ali_Cnt = C Else Ali_Cnt = 0 End Function في امان الله

السلام عليكم جرب هذا التعديل لو تنضم الجدول في كافة الاوراق افضل مثل روؤس الاعمدة تكون ثابته في كافة الأوراق بين الملف لاني محدد جلب البيانات في الكود من السطر الثاني الى اخر صف وبلاحظ وجود روؤس اعمدة في البيانات بمعنى السطر الاول عناوين وما يليه البيانات كي يعمل معك الكود بصورة صحيحة Public S As String Public Sub Ali_Rn() Dim W As Workbook, Wr As Workbook Dim Sh As Worksheet Dim Path$, My_F$, A_Num, i%, Lc&, L_A&, C Dim Rng As Range Dim A_Lst As Range SPd False Ali_Clr On Error Resume Next Set Wr = ThisWorkbook Path = ThisWorkbook.Path & Application.PathSeparator My_F = Dir(Path & "*.xlsx") Do While My_F <> "" If Not My_F = Nm Then Workbooks.Open Filename:=Path & "\" & My_F Set W = Workbooks(My_F) For Each Sh In W.Worksheets With Sh SPd False Set Rng = .Range(.Cells(2, 1), .Cells(500, 35)) With Rng S = Replace(W.Name, ".xlsx", "") Set A_Lst = .Cells(2, .Columns.Count).End(xlToLeft) A_Num = A_Lst.Column End With L_A = .Cells(.Rows.Count, "A").End(xlUp).Row With Wr.Worksheets(.Name) Lc = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row For C = 1 To A_Num For i = 2 To L_A .Range("A" & Lc - 1).Cells(i, C).Value = Sh.Cells(i, C).Value .Range("A" & Lc - 1).Cells(i, A_Num + 1).Value = S Next i Next End With End With A_Num = 0: R_Num = 0 Next W.Close 0 SPd True End If My_F = Dir Loop SPd True End Sub Private Function SPd(Bn As Boolean) With Application .Calculation = IIf(Bn, -4105, -4135) .EnableEvents = Bn .ScreenUpdating = Bn .DisplayAlerts = Bn End With End Function Private Sub Ali_Clr() Dim Dh As Worksheet For Each Dh In ThisWorkbook.Worksheets Dh.UsedRange.Cells.ClearContents Next End Sub

وهذا تعديل لكود الاخ البروفيسر لحذف كافة الأوراق ماعدا المسماه "prof" غيره الى اسم الورقة التي لاتريد حذها Sub Hideallsheets() 'حذف كل الشيتات Dim sh As Object For Each sh In ActiveWorkbook.Sheets If sh.Name <> "prof" Then 'sh.Visible = xlSheetHidden '******* Application.DisplayAlerts = 0 sh.Delete Application.DisplayAlerts = 1 '******* End If Next End Sub

كم عدد الأعمدة المراد ترحيلها كعدد ثابت لجميع الأوراق ؟ حسب ملفك الاصلي

السلام عليكم جميل ان المضروف سادة بدون خطوط جرب التعديل في المرفق Nm_Adrs_Ali_2.rar

السلام عليكم حبذا ترفق صوره للمضروف عشان نعرف اين موقع الكتابه جرب هذا التعديل Nm_Adrs_Ali_1.rar

إن توفر الوقت سوف اعمل عليه وإن شاء الله خير تحياتي

السلام عليكم الاخ والاستاذ الفاضل الشهابي جزاك الله خير على عملك الجميل تقبل مروري

السلام عليكم الاخ الفاضل عادل كيف احوالك ان شاء الله بأفضل حال بعد اذن الاخوة الافاضل جرب المرفق تحدد الاسماء واحد تلو الاخر او تحديد الكل ارجو ان وفقت بتنفيذ ماتصبو اليه Nm_Adrs_Ali.rar

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

السلام عليكم إخوتي الاحبه أعضاء وأساتذة منتدانا الغالي أقدم كود يقوم بالبحث في سلسلة نصيه ويستخرج ( الكلمات العربيه - والكلمات الانجليزي - والأرقام ) وكل سلسلة في عمود المدى الإفتراضي عمود "A" أرجو التجربه إن وجدت اي ملاحظات أو أخطاء Public Sub Cnvrt_Ali() Dim L_A&, i& On Error Resume Next ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\vbscript.dll\3" On Error GoTo 0 With ActiveSheet L_A = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 2 To L_A .Range("B" & i).Resize(1, 3).Value = S_Nm_Ali(.Range("A" & i).Value) Next i End With End Sub Private Function S_Nm_Ali(ByVal Nms As String) Dim E$, A$, Nm$ Dim V_r As Object Set V_r = CreateObject("VBScript.Regexp") On Error Resume Next With V_r .Global = True .IgnoreCase = True .Pattern = "\w|\n|\-|\(|\)|\&|\." A = Trim(.Replace(Nms, "")) .Pattern = "\D+" E = Trim(.Replace(Nms, "")) .Pattern = "[-?\d+(\.\d+)?|\u0600-\u06FF]" Nm = Trim(.Replace(Nms, "")) End With S_Nm_Ali = Array(A, E, Nm) Set V_r = Nothing End Function Ali_String.rar

السلام عليكم الصق المعادلة التالية في خلية E3 =SUMPRODUCT(--(B2:B5000);--(A2:A5000<$C$3))

المخرجات تكون اخر الجدول اول ماذا ؟ ارفق مثال للتضح الصورة بشكل افضل وان شاء الله خير لإرفاق مثال : قم بضغط ملف الإكسل باأحد برامج الضغط ( Winrar أو Winzip ) ثم إرفقه

قواعد المشاركة فى الموقـع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكد على ما يلي : 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف تم تعديل عنوان المشاركة نرجو الإلتزام بقواعد المشاركة في مشاركاتك القادمة

ارى الهوامش مزبوطه تعديلات بسيطه ربما هكذا تريد التعليم الابتدائي1.rar

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

تم تعديل عنوان المشاركة

وضح الطلب اذا تكرمت هل هذا طلبك

راجع موضوعك المشاركة الاخيرة http://www.officena....showtopic=49187

السلام عليكم اطلع على المرفق ارجو ان تجد به ضالتك طاولة مشتركة_A.rar

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

السلام عليكم ActiveCell.Value = ListBox1.Value

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