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

تفضل المرفق التالي .. وإذا لم يكن المطلوب وضح اكثر بملف مرفق من عندك إذ أني أخبرتك أني لا أعمل على التخمين وفيه نقطة مهمة لابد من العلم بها أنه طالما الصفوف مخفية في النطاق A2:F27 فلا يمكن أن تظهر نفس الصفوف في النطاق H2:M27 وإنما ما يمكن إظهاره وإخفاؤه هو الأعمدة نفسها من H إلى M عموماً المرفق عدلت فيه قليلاً حيث قمت في ورقة الـ recycle بحذف صفوف فارغة بحيث تبدأ البيانات من أول الصف الثالث (لأنك سألت عن تلك النقطة من قبل) وقمت بفك الحماية عن عمود الكميات وخلية التاريخ بحيث تتمكن من الإدخال والورقة محمية فاتورة.rar

بارك الله فيك أخي أبو عبد الواجد وجزيت خيراً على دعائك الطيب ، ولك بمثله إن شاء العلى القدير

يمكن أن يطرح موضوع جديد من بداية جديدة ..لا مشكلة في ذلك أي تطرح الموضوع وترفق ملف وبه آخر ما استجد في الكود فيه وتشرح المطلوب عليه حتى يشارك الجميع ... عموماً ما هي النقطة التالية التي يجب معالجتها الآن واشرح بالتفصيل .. لأفهم المشكلة لديك آخر نقطة تحدثنا بها وهي إظهار الصفوف المخفية بعد الترحيل وقد وجهتك لتغيير النطاق من rg إلى A2:F26 >> فهل قمت بحل هذه النقطة أم لا؟

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

من الأفضل تناول نقطة نقطة لأني لا أملك الوقت الآن للعمل على كل النقاط مرة واحدة .. والأفضل إرفاق ملف معبر عن المطلوب كما أخبرتك من قبل الآن تغيرت هيكلة الملف ويوجد تفاصيل جديدة غير موجودة في الملف الأول سأجيبك على نقطة واحدة فقط ألا وهي الصفوف المخفية .. قم باستبدال كلمة rg في السطر التالي rg.EntireRow.Hidden = False بهذه الكلمة ws.Range("A5:F26") كما يفضل أن يكون لكل طلب موضوع مستقل لتجد استجابة أفضل من الأعضاء بالمنتدى تقبل تحياتي

ارفق ملف .. لأن هيكلة الملف الأول كما فهمت تعتمد على وجود ثلاثة أوراق عمل ولكل ورقة عمودين بالاسم واللقب ..أما بعد زيادة أوراق العمل فيهمني أن أرى الهيكلة الجديدة مع وضع بعض النتائج المتوقعة

السلام عليكم جرب الكود التالي عله يفي بالغرض .. في ورقة العمل المسماة recycle اجعل عنوان أول فاتورة موجودة في الصف رقم 3 عند التعامل مع ورقة العمل invoice تأكد أن كلمة السر مفعلة .. ولكن قبل ذلك يجب أن تقوم بتغيير خصائص خلايا الإدخال (التاريخ وعمود الكميات) ، وذلك عن طريق تحديد الخلايا ثم كليك يمين ثم Format Cells ثم التبويب Protection وأزل علامة الصح بجانب الخيار Locked .. بحيث تتمكن من عملية الإدخال والورقة محمية الآن بعد ضبط أوراق العمل جرب الكود التالي Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim rg As Range Application.ScreenUpdating = False Set ws = Sheets("invoice") Set sh = Sheets("recycle") Set rg = ws.Range("A5:F26").SpecialCells(xlCellTypeVisible) ws.Protect Password:="11", AllowFormattingRows:=True, UserInterfaceOnly:=True, Contents:=True, Scenarios:=True, DrawingObjects:=False If IsEmpty(ws.Range("D7")) Or Application.WorksheetFunction.CountA(ws.Range("D10:D25").SpecialCells(xlCellTypeVisible)) = 0 Then MsgBox "No Data", vbCritical: Exit Sub sh.Rows(3).Resize(rg.Rows.Count + 3).Insert Shift:=xlDown rg.Copy: sh.Range("A3").PasteSpecial xlPasteValues rg.Copy: sh.Range("A3").PasteSpecial xlPasteFormats sh.Range("A7").CurrentRegion.Interior.Color = xlNone ws.Range("D7").ClearContents ws.Range("D10:D25").SpecialCells(xlCellTypeVisible).ClearContents ws.Range("D5").Value = ws.Range("D5").Value + 1 rg.EntireRow.Hidden = False Application.Goto ws.Range("A26") Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub إذا أدى الكود الغرض لا تنسى الإعجاب وتحديد أفضل إجابة ليظهر الموضوع منتهي تقبل تحياتي

سأطلع عليه إن شاء الله في أقرب وقت ..

إزاي مش فاهم وإنت اسمك علي فاهم (إني أمزح معك) ايه اللي مش مفهوم حاول توضح المشكلة بالنسبة لك فين .. واسأل ولا تخجل من السؤال هل قمت بإدراج فورم؟ إذا كان الأمر كذلك قم بإظهار الـ ToolBox أي صندوق الأدوات من قائمة View (إذا لم يكن ظاهر) ثم من صندوق الأدوات اسم زرر أمر CommandButton وانقر عليه دبل كليك .. هيفتح معاك موديول الفورم ضع فيه هذا السطر Application.Visible = True

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

نعم هذا صحيح لأن في الكود سطر يقوم بإخفاء التطبيق .. ويمكن معالجة ذلك عن طريق أن تقوم برسم زر أمر على الفورم وتضع فيه سطر يظهر التطبيق في هذا السطر الذي يخفي التطبيق Application.Visible = False القيمة هنا False . ضع القيمة True لإظهار التطبيق خلاصة القول ضع سطر لإظهار التطبيق في زر الأمر الذي ستقوم برسمه على الفورم

أخي الكريم وضح التفاصيل أكثر ليستطيع الأخوة الأعضاء مساعدتك ..ارفق ملف بسيط فيه فورم بسيط ووضح عليه المطلوب

أخي الكريم علي .. الموضوع بسيط ولا يحتاج لملف مرفق على الإطلاق وسأعطيك الخطوات لتتعلم بنفسك .. فتعلم الصيد خير من تناول سمكة كل يوم قم بفتح برنامج الإكسيل اضغط Alt+F11 وضع الكود المقدم من قبل أخونا زياد في موديول عادي عن طريق قائمة Insert ثم اختر Module من نفس القائمة Insert قم بإدراج فورم UserForm1 احفظ الملف وستظهر رسالة اختر منها No وحدد صيغة الحفظ بـ Macro-Enabled Workbook أو ما يعرف بـ xlsm ... الآن أغلق الملف وأعد فتحه وأدخل كلمة السر الموجودة في الكود تقبل تحياتي

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

بارك الله فيك أخي العزيز سليم المعادلات تمام لكن لم تقم باستخراج العدد بالمعادلات هذا من ناحية .. من ناحية أخرى يوجد خلل في كلا الحلين حيث أن هناك أخطاء في الصفوف من 303 إلى 316 في الحل الذي قدمته بالـ Power Query وبالحل الذي قدمته أخي سليم بالمعادلات لذا قمت بعمل كود يعالج الأمر .. والرجاء من الأخ الكريم أبو عبد الواجد إنه يصحصح ويشوف النتائج كويس .. مش سلق بيض هو :) إليك الكود التالي عله يفي بالغرض ويصحح الأخطاء Sub Test() Dim a As Variant Dim b As Variant Dim s As String Dim i As Long a = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim b(1 To UBound(a, 1), 1 To 3) For i = LBound(a, 1) To UBound(a, 1) s = CStr(a(i, 1)) b(i, 1) = Trim(Mid(s, 1, InStr(s, "(") - 1)) b(i, 2) = NumByStr(s, "قطعة") b(i, 3) = NumByStr(s, "سعر") Next i Range("B2").Resize(UBound(b, 1), UBound(b, 2)).Value = b End Sub Function NumByStr(strLong As String, strShort As String) As Variant Dim e As Long Dim s As Long e = InStr(1, strLong, strShort, vbTextCompare) If e <= 1 Then NumByStr = "" Exit Function End If Do Until IsNumeric(Mid(strLong, e, 1)) Or Mid(strLong, e, 1) = "." Or Mid(strLong, e, 1) = "," e = e - 1 If e = 0 Then NumByStr = "" Exit Function End If Loop s = e Do While IsNumeric(Mid(strLong, s, 1)) Or Mid(strLong, s, 1) = "." Or Mid(strLong, s, 1) = "," s = s - 1 If s = 0 Then Exit Do Loop NumByStr = Mid(strLong, s + 1, e - s) End Function

وعليكم السلام أخي الكريم ماذا تقصد بتعطيل مفاتيح الأوامر .. وضح أكثر المطلوب ولماذا تريد تعطيل هذه المفاتيح؟

هل ورقة النتائج ستكون مختلفة ..أقصد هل سيضاف أعمدة أخرى لكل ورقة عمل؟ !!!

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

وعليكم السلام أخي الكريم جرب الملف التالي .. ستجد ورقة عمل منفصلة بالنتائج .. إذا قمت بعمل تغيير في ورقة البيانات .. عليك أن تذهب لورقة النتائج وتعمل كليك يمين ثم Refresh لتحديث النتائج فرز البيان = اسم المادة - عدد القطع - سعر القطعة الواحدة - 1.rar

وعليكم السلام أخي الكريم زياد جرب الكود التالي في حدث ورقة العمل المراد التجميع فيها قم بكتابة القسم في العمود الثاني .. Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim xf As Variant If Target.Cells.Count > 1 Then Exit Sub If Target.Row > 3 And Target.Column = 2 Then Application.EnableEvents = False If Target = "" Then Target.Offset(, -1).ClearContents: Target.Offset(, 1).Resize(, 6).ClearContents: GoTo Skipper For Each ws In ThisWorkbook.Worksheets(Array("وحدة الانتاج", "وحدة النقل", "وحدة التوزيع")) xf = Application.Match(Target, ws.Columns(2), 0) If IsNumeric(xf) Then Target.Offset(, -1) = Target.Row - 3 Target.Offset(, ws.Index * 2 - 1) = ws.Cells(xf, 3) Target.Offset(, ws.Index * 2) = ws.Cells(xf, 4) End If Next ws Skipper: Application.EnableEvents = True End If End Sub

بارك الله فيك أخي العزيز زيادة فكرة جميلة وبسيطة وأفضل من وجهة نظري من الفورم إذ أن المهم الأداء العملي والفعلي للملف ..لا مجرد جماليات وفارغ من المضمون

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

موضوع مكرر .. يحذف

جرب الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 7 And Target.Column = 5 Then Application.EnableEvents = False On Error GoTo Skipper If Target.Value = "" Then Target.Offset(, 1) = "" Target.Offset(, 1) = Application.WorksheetFunction.VLookup(Target, Range("I8:J20"), 2, False) Skipper: Application.EnableEvents = True End If End Sub

تفضل الملف ولكن لابد أن تتعلم بنفسك الأمور الأساسية EXCELFILE.rar