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

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

وعليكم السلام يمكنك استبدال الكود لتصبح النتائج كما تريد مرفق ربطاً الملف أما إن كانت لا تزال هناك مشكلة في ظهور اللغة فأنت بحاجة إلى تعديل الإعدادات من لوحة التحكم خيارات اللغة كما أن الكود السابق الموجود لديك يعمل بشكل صحيح وقد رأيت أنك استخدمته كمعادلة الصفيف بضغط Ctrl+shift+enter >>> جرب كتابة المعادلة ثانية بالضغط فقط على Enter وستحل المشكلة لديك بإذن الله تقبل تحياتي. المصنف1.xlsm

الاخوة الاعزاء ارجو معرفة كيفية عمل دالة فى استعلام يقوم بجمع عدة اسماء فى حقول الى حقل واحد ولا يشترط الترتيب فى المثال المرفق اريد كتابة كل مواد التظلم في حقل مواد التظلم تظلمات.rar

حسب ما يتضح أن مشاركة الأستاذ @حمدى الظابط كانت مجرد لفت نظر حسب ما أوضح ولم تكن طلبا جديدا .. 🙂 لذلك إن لزم التوسع فيه .. فيرجى التكرم بفتح موضوع جديد.. أما الآن فدعونا نستمتع بإبداعاتكم في موضوع تقسيم السجلات إلى أن يحصل الأخ @وائل طه على مبتغاه .. أو تنفد الأفكار دونه .. 🙂🌷

I don't attach files Wait someone to attach the file for you Just follow the steps and you will be able to make it run properly

The file is not perfect. Generally try the following code In standard module paste the following code Option Explicit Sub Get_Data_By_Subject() Const FIXEDROWS As Long = 20, FIXEDCOLS As Long = 5 Dim a, v, xCol, ws As Worksheet, sh As Worksheet, rng As Range, i As Long, ii As Long, k As Long, iStart As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False With ThisWorkbook Set ws = .Worksheets("ola"): Set sh = .Worksheets("lagna") End With a = ws.Range("B6:T102").Value ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2)) xCol = Application.Match(sh.Range("L3").Value, ws.Rows(5), 0) If Not IsError(xCol) Then For i = LBound(a) To UBound(a) If a(i, xCol - 1) <> Empty Then k = k + 1 For ii = LBound(a, 2) To UBound(a, 2) b(k, ii) = a(i, ii) Next ii End If Next i If k > 0 Then iStart = IIf(sh.Range("B9").Value = Empty, 1, sh.Range("B9").Value) Set rng = sh.Range("C9").Resize(FIXEDROWS, FIXEDCOLS) If iStart > k Then rng.ClearContents: GoTo Skipper v = ExtractArray(b, iStart, FIXEDROWS, FIXEDCOLS) sh.Range("B9").Resize(FIXEDROWS).Value = Evaluate("ROW(" & iStart & ":" & iStart + FIXEDROWS - 1 & ")") With rng .ClearContents .Value = v End With End If End If Skipper: Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End Sub Function ExtractArray(ByVal arr, ByVal iStart As Long, ByVal iRows As Long, ByVal iCols As Long) Dim i As Long, ii As Long ReDim outputArr(1 To iRows, 1 To iCols) For i = iStart To iStart + iRows - 1 For ii = 1 To iCols outputArr(i - iStart + 1, ii) = arr(i, ii) Next ii Next i ExtractArray = outputArr End Function In worksheet named Lagna paste the following module Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$L$3" Then Application.ScreenUpdating = False Range("B9:I28").ClearContents Application.ScreenUpdating = True End If End Sub By the way after selecting the subject click the down arrow of the spinner not the up arrow

لك مني كل الشكر والتقدير هذا بالفعل ما اريد جزاك الله كل خير

السلام عليكم اليك هذا الملف بعد التعديل 7777.xlsm

ياريت يكون على Drop Down وليس list , ولكن شكرا على مجهودك استاذي كريم نظيم

الاخ الفاضل / شايب شكراً لحضرتك على التوضيح والتعديل على الملف المرفق وهى فكرة اكثر من ممتازة وجزاك الله خيرا

وعليكم السلام ورحمه الله كود اخفاء قاعده البيانات واظهار فورم1 Private Sub Workbook_Open() Worksheets("Dbsheet").Visible = False UserForm1.Show End Sub كود للترحيل Dim lr As Long lr = WorksheetFunction.CountA("DbSheet").Range("A:a") Sheets("DbSheet").Cells(lr + 1, 1).Value = TextBox1 Sheets("DbSheet").Cells(lr + 1, 2).Value = TextBox2 Sheets("DbSheet").Cells(lr + 1, 3).Value = TextBox13 Sheets("DbSheet").Cells(lr + 1, 4).Value = TextBox4 Sheets("DbSheet").Cells(lr + 1, 5).Value = TextBox5 Sheets("DbSheet").Cells(lr + 1, 6).Value = TextBox6

اتفضل حل اخر بدون عمود مساعد =IF(COUNTIFS($A$2:$A$18,A2,$I$2:$I$18,I2,$J$2:$J$18,J2)>1,"تعارض","") conflict.xls

السلام عليكم ورحمه الله وبركاته ايه رائيك تشوف الموضوع ادناه قد يفيدك قائمة منسدلة مفلترة2.rar

تفضل أخي Query1 بحقل BB . DD151.Accdb تفضل أخي Query1 بحقل BB .

وعليكم السلام ورحمة الله تعالى وبركاته اليك حل بديل بالاكواد اول خطوة قم بتسمية نطاق عمود التصنيف بالشكل التالي =OFFSET(التعريف!$E$3;;;COUNTA(التعريف!$E:$E)-1) 2) وقم باظافة عنصر Combobox في اول خلية للقائمة المنسدلة G3 3) ضع هدا الكود في حدث شيت صفحة الادخال Dim F(), MH, Rng Private Sub ComboBox1_Change() Dim MH() MH = Application.Transpose([liste]) Me.ComboBox1.List = MH If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, MH, 0)) Then Me.ComboBox1.List = Filter(MH, Me.ComboBox1.Text, True, vbTextCompare) Me.ComboBox1.DropDown End If ActiveCell.Value = Me.ComboBox1 If ComboBox1.Value <> "" Then ComboBox1.BackColor = RGB(255, 255, 255) Else ComboBox1.BackColor = &HFFFF00 End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim lr As Long Dim sh1 As Worksheet: Set sh1 = Worksheets("صفحة الادخال") Dim sh2 As Worksheet: Set sh2 = Worksheets("التعريف") lr = sh1.Range("A" & Rows.Count).End(xlUp).Row Set wsdata = Range("G3:G" & lr) If Not Intersect(wsdata, Target) Is Nothing And Target.Count = 1 Then If MH <> "" Then If IsError(Application.Match(Range(MH), F, 0)) Then Range(MH) = "" F = Application.Transpose(sh2.Range("Liste")) Me.ComboBox1.Height = Target.Height + 4 Me.ComboBox1.Width = Target.Width Me.ComboBox1.Top = Target.Top Me.ComboBox1.Left = Target.Left Me.ComboBox1 = Target Me.ComboBox1.Visible = True Me.ComboBox1.Activate MH = Target.Address Else Me.ComboBox1.Visible = False End If End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Set Rng = ActiveCell If KeyCode = 13 Then If IsError(Application.Match(Rng, F, 0)) Then Rng = "" Rng.Offset(1).Select End If End Sub Private Sub ComboBox1_DropButtonClick() lr = Worksheets("التعريف").Cells(Rows.Count, 5).End(xlUp).Row ComboBox1.List = Sheet2.Range("E2:E" & lr).Value End Sub Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If Not iGblInhibitTextBoxEvents Then ComboBox1.Value = "" End If End Sub 3) دوبل كليك على combobox وابحث باي حرف في اي مكان في السطر . حركة الصندوق.xlsb

وعليكم السلام ورحمه الله وبركاته اتفضل لعله المطلوب تم عمل عمود مساعد =IF(COUNTIF($L$2:$L$18,L2)>1,"تعارض","") conflict.xls

يمكن الوصول للنتيجة بدون استخدام دوال تجميع المجال وخصوصا ان الخبراء ينصحون بتجنب استخدامها في الاستعلام وللوصول للنتيجة عن طريق العلاقات النتيجة في استعلام q_1 EXAMPLE2000.mdb

حدثت مشكلة عندي في الملف ولم استطع ارفاقة بدل الجملة عندك بهذه DLookUp("[Material Type]";"[Group]";"[Group no] =" & [No] & "")

نرجوا مراعاة قواعد المشاركات افراد كل موضوع بعنوان مستقل

المشكلة هنا في الاسمار المركبة مثلاً: فرج الله نجيب مرسي اسم ثلاثي لكن الاكسل يفهمه رباعي (مؤلف من 4 كلمات) سيف الاسلام محمد فضل الدين اسم ثلاثي لكن الاكسل يفهمه خماسي لذا يجب القيام باضافة عامود الى الجدول يحدد نوع الاسم (و تقوم بالفرز على اساسه) مثل هذا الملف Name_kind.xlsx

هناك موضوع أكثر أهمية في هذا الملف حيث تستطيع اختيار المرتبة التي تشاء (ليس الخامسة فقط بل الرابعة مثلا أو السابعة) تضع المرتبة التي تريد في الخلية E2 المعادلات في الملف محمية لعدم العبث بها عن طريق الخطأ Choose_grade.xlsm

جرب هذا الملف Grade By_Item.xlsm

السلام عليكم ان كنت تريد طباعة بطاقة كل الطلاب دفعة واحدة Sub test() Dim ws As Worksheet: Set ws = Sheets(1) Dim wsp As Worksheet: Set wsp = Sheets(2) Dim lrw As Long Dim i As Integer lrw = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lrw wsp.Range("D4") = ws.Range("A" & i) wsp.Range("C5") = ws.Range("B" & i) wsp.Range("D6") = ws.Range("C" & i) wsp.Range("Prnt").PrintOut Next End Sub المصنف1.rar