ياسر خليل أبو البراء

أخي الكريم خالد جرب الكود التالي عله يفي بالغرض (طبعاً يوضع الكود في المصنف المسمى PickList) ويحفظ بامتداد xlsm ... قم بفتح الملف الأول والملف الجديد الذي قمت بحفظه بامتداد xlsm ونفذ الكود وستظهر النتائج في العمود الثاني في الملف الجديد المسمى PickList.xlsm Sub Test() Dim swb As Workbook Dim twb As Workbook Dim arr1 As Variant Dim arr2 As Variant Dim v As Variant Dim d As Object Dim m As Long Dim n As Long Dim r0 As Long Dim r As Long Dim s As Long Dim c As Long Set swb = Workbooks("SerializePlantStockReport.xlsx") Set twb = ThisWorkbook Set d = CreateObject("Scripting.Dictionary") m = swb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row arr1 = swb.Sheets(1).Range("C2:E" & m).Value n = twb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row arr2 = twb.Sheets(1).Range("A2:B" & n).Value For s = 1 To n - 1 v = arr2(s, 1) If d.exists(v) Then r0 = d(v) Else r0 = 0 End If For r = r0 + 1 To m If arr1(r, 1) = v Then arr2(s, 2) = CStr(arr1(r, 3)) d(v) = r Exit For End If Next r Next s twb.Sheets(1).Range("A2:B" & n).Value = arr2 End Sub

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

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

حاول توضح أكتر .. الأفضل من وجهة نظري أن تكون البيانات متتالية ولا يفصل بينها فاصل .. سطر فارغ كما تريد وإذا كنت تريد ذلك ما الذي سيحدد الصف الفارغ .. ربما كفكرة أن تقوم بإنشاء CheckBox وإذا كانت قيمتة True يتم زيادة قيمة المتغير lr بمقدار 2 ويعطي تسلسل جديد يبدأ من 1 .. ما زالت الفكرة غير مكتملة لربما لعد وضوح الرؤية بالنسبة لي قم برسم مربع CheckBox1 وجرب الكود التالي عله يفي بالغرض Private Sub TextBox2_Change() Dim ws As Worksheet Dim lr As Long Set ws = Sheets("الادارة الصحية") lr = ws.Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value + 1 If CheckBox1.Value = True Then lr = 1 TextBox1.Value = lr End Sub

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

وعليكم السلام أخي الكريم ما زلت لا أفهم المطلوب .. هل المطلوب عملية بحث عن الأرقام في الملف الأول ووضعها في الملف الثاني .. ما هو المنطق في عملية البحث .. وهل سيكون الملف الأول مفتوح أم مغلق حين إجراء عملية البحث ..؟ لابد من الإجابة على هذه التساؤلات أولاً

لا أعتقد أنه يمكن عمل الكود بالشكل العادي لأنك تريد أن يتم تنفيذ الكود بمجرد التغيير في العمود e .. إذ أنه كيف سيعرف الإكسيل أنه تم التعديل في العمود e .. بالنسبة للنقطة التي تتحدث بخصوصها يمكن نسخ الصف ويمكن استخدام كلمة Copy بدلاً من كلمة Delete ثم تحدد المكان المطلوب النسخ إليه .. وبعد القيام بعملية النسخ ستضيف سطر الحذف مرة أخرى .. إذ أنني لا أحبذ عملية القص فالأفضل إجراء نسخ للصف ثم حذف له ..

أخي الكريم محمود جرب الكود التالي (هل هذا ما تقصده؟) Private Sub TextBox2_Change() Dim ws As Worksheet Dim lr As Long Set ws = Sheets("الادارة الصحية") lr = ws.Cells(Rows.Count, 1).End(xlUp).Row TextBox1.Value = lr - 1 End Sub

وعليكم السلام أخي الكريم أعتقد أن الموضوع مكرر .. يرجى إرفاق ملف وعدم طرح أكثر من موضوع لنفس الطلب .. حسب علمي يوجد خاصية RowSource يمكن استخدامها وتغيير Columnsheaders إلى القيمة True

لغة الإكسيل التي أقصدها يفهمها الجميع من المبتديء للمحترف ... وهي ورقة العمل كذا .. النطاق كذا والعمود كذا والصف كذا والخلية كذا .. ربما سيكون أيسر لو وضعت صورة لمثال متوقع .. يمكنني العمل على ملفك بالتخمين لكني لست من مؤيدي التخمين حيث جربته كثيراً وأعتبره مضيعة للوقت والجهد .. كلما كانت المعطيات واضحة كلما وجدت استجابة أفضل .. قد لا أمتلك الحل لك لكني أحاول وضع ردود ليظهر موضوعك وتتضح الصورة لبقية الأخوة الأعضاء .. أرجو أن تتقبل نصيحتي بصدر رحب .. والرجاء مراجعة موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى عموماً رغم أنني لا أحب التخمين .. وحتى لا تحدثك نفسك بأني مضيعة للوقت لك إليك الكود التالي .. ضع الكود في حدث ورقة العمل .. كليك يمين على اسم ورقة العمل المطلوب العمل عليها ثم View Code ثم ضع الكود التالي .. وأرجو أن يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 5 And Target.Row > 2 Then Application.EnableEvents = False Dim m As Long Dim x, y m = Cells(Rows.Count, 1).End(xlUp).Row + 1 Range("A" & m).Resize(1, 4).Value = Range("A" & Target.Row).Resize(1, 4).Value x = Target.Offset(, -3).Value - Target.Offset(, 5).Value y = Target.Offset(, -3).Value - Target.Value Range("J" & m).Value = x: Range("H" & m).Value = y Target.EntireRow.Delete Application.EnableEvents = True End If End Sub

الأفضل طرح موضوع جديد مع إرفاق ملف أخي الكريم محمد فاروق

تفضل أخي الكريم الملف Create Sheets For Template For All Names YasserKhalil LOF.rar

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

أو قم بعملية الاستثناء بعد سطر الحلقة التكرارية For x = 1 To k حيث يمكن أن تستخدم جملة الشرط IF وتقول إذا كانت ورقة العمل المتغيرة Sheets(x) لا تساوي كذا و (تستخدم And) لا تساوي كذا .. وأكمل .. و لاتنسى إغلاق جملة الشرط بجملة End IF للمزيد

وعليكم السلام أخي الكريم فرحات مستور أشرف .. لم تحدد اسمك بعد الحمد لله أن تم المطلوب على خير ... وجزيت خيراً بمثل ما دعوت لي تقبل تحياتي

في أسفل الفيديو يوجد رابط للملف المرفق قم بتحميله وادرس الكود والملف وطبقه على ملفك وإن شاء الله تفلح في المهمة وفقك الله

وعليكم السلام FMA (فرج محمد أحمد) أو (فؤاد محمود أردوغان) أو (فايز منصور أمجد) أو (فريد ممدوح أسعد) ... كفاية كدا تخمينات جرب المعادلة التالية .. =SUM(COUNTIF(A3:G3,"b"),COUNTIF(A3:G3,"c"),COUNTIF(A3:G3,"d"))

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

السلام عليكم أخي الكريم طارق الخطأ في عدد الأعمدة .. يجب أن تكون عدد الأعمدة المراد ترحيلها يساوي عدد الأعمدة المطلوب الترحيل إليها . جرب الكود التالي عله يكون المطلوب Sub Test() Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long arr = Sheets("تموز").Range("A1").CurrentRegion.Value 'الأعمدة المطلوب الترحيل إليها cr = Array(13, 14, 15, 16, 17, 18, 19, 20, 21, 22) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12) Sheets("all").Cells(1, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub

السلام عليكم أخي محمود .. جرب الكود التالي عله يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) Dim a As Variant Dim i As Long Dim r As Long a = Range("A2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value For i = LBound(a, 1) To UBound(a, 1) If a(i, 2) <> "" Then r = r + 1: a(i, 1) = r Else r = 0: a(i, 1) = "" End If Next i Application.EnableEvents = False Range("A2").Resize(UBound(a, 1), UBound(a, 2)).Value = a Application.EnableEvents = True End Sub وإن كنت لا أحبذ الأكواد في حدث ورقة العمل إلا للضرورة ..

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

يمكن إضافة أوراق عمل كما تريد من خلال السطر الموضح في الحلقة التكرارية .. جملة Array .. والمعادلة تعمل حسب المرفق الأول .. سواء معادلة الأخ سليم أو المعادلة التي قدمتها وأنا لا أعمل على أكثر من مرفق في الموضوع الواحد .. أعتذر إليك

وجزيت خيراً أخي الكريم بمثل ما دعوت لي الحمد لله أن تم المطلوب على خير

إذا كنت تريد المعادلة في ملف آخر والملف الأصلي مفتوح استخدم المعادلة التالية =INDEX(SerializePlantStockReport.xlsx!E$2:E$26,RANDBETWEEN(2,26)) إذا لم تكن المعادلة تلبي الغرض يرجى مزيد من التوضيح ووضع بعض النتائج المتوقعة ...

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