عبدالفتاح في بي اكسيل

وعليكم السلام .لماذا لم تجد المساعدة لانك لم تضع النتائج المتوقعة للحالات التي ذكرتها كما دائما نبهنا بعدم دمج الخلايا .بالتوفيق

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

حقا !!! تريدني ان اقوم بتنسيق ملفك وانت من تريد المساعدة . هذا اهدار لوقتي ولست مستعد لمراجعة الخلايا المدمجة . لن ادخل في هكذا مواضيع في المستقبل . على اي حال لضيق وقتي هذه محاولة بخصوص المطلوب الاول . ولم افهم شيء بخصوص المطلوب الثاني , وما الهدف منه ؟ كما تلاحظ من خلال الكود قمت بتخصيص الايام بالعربي لانه تظهر بالانجليزي ( عندما تتغير القيم في خلايا العمود C سوف يدرج تاريخ اليوم ويوم من الاسبوع) Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim TodayValue As String If Target.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("C:C")) Is Nothing Then TodayValue = Choose(Weekday(Date), "الاحد", "الاثنين", "الثلاثاء", "الاربعاء", "الخميس", "الجمعة", "السبت") Target.Offset(0, -1) = Date Target.Offset(0, -2) = TodayValue End If End Sub تحياتي .

بناء على شرحك في المنشور الاول 816/52.39=15.57549 ثم يتم ضربها مثلا للصنف الاول 15.57549X14=218 وعند جمع اجمالي توزيع القيمة على كل الكميات يعطيك اجمالي الشحن 816 لا تستغرب لا احد يخوض في موضوعك لانك لم تضع امثلة كيف يكون ناتجك . اذا لم يكن ما تريده ربما شخص اخر يفهم سؤالك . انا اكتفيت الى هنا علي افساح المجال لغيري . بالتوفيق .

جرب هذه المعادلة =IF(C2="","",IF(SUM($C$2:C2)=$C$22,$K$2-SUM($D$1:D1),ROUND(($K$2/$C$22)*C2,0)))

جرب هذا الملف ..اذا تم كتابة اسم الورقة خطا ستظهر لك رسالة تجنبا لاي خطا بالكود لا تحتاج الى زر للورقة الاولى الازرار للاوراق الاخرى عند الرجوع للصفحة الرئيسية . ACTIVATION.xlsm

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

عذرا اخت ياسمين حقيقة لم اقتنع بتخطيط البيانات للورقة ارى انها ليست لائقة . كما ان مشاركتك السابقة بالمخزون كانت محيرة تكررين نفس كميات المخزون لذلك تركت المجال لغيري لعله يفهم بياناتك يحبذ تنظيم البيانات في المرة القادمة . لقد قمت بتنظيمها بعض الشيء كما انه يوجد لديك خلايا مدمجة يجب الغاؤها حتى لا يتسبب مشاكل في الاكواد . اذا كنت مصرة على نفس التخطيط لبياناتك حينها اترك المجال لغيري ليقوم ما يلزم لضيق وقتي . Sub test() Dim findStr As String Dim i As Long, r As Long Dim sh1 As Worksheet, sh2 As Worksheet, Arr() Set sh1 = ThisWorkbook.Worksheets("Transaction") Set sh2 = ThisWorkbook.Worksheets("Receipt") With sh1 Arr = .Range(.Cells(2, 1), .Cells(LastRow(sh1), 11)).Value End With findStr = InputBox("Please Enter Receipt NO", "Receipt NO") sh2.Range("A7").CurrentRegion.ClearContents Application.ScreenUpdating = False With sh2 .Range("A6:D6").Value =Array("Date", "Description", "QTY", "Price USD", "Price LBP") For i = LBound(Arr) To UBound(Arr) If Arr(i, 11) = findStr Then r = LastRow(sh2) + 1 .Cells(r, 1) = Arr(i, 1) .Cells(r, 2) = Arr(i, 3) .Cells(r, 3) = Arr(i, 8) .Cells(r, 4) = Arr(i, 4) .Cells(r, 5) = Arr(i, 5) .Cells(4, 2).Value = findStr End If Next End With Application.ScreenUpdating = True End Sub Function LastRow(ByVal ws As Worksheet, Optional ByVal col As Variant = 1) As Long With ws LastRow = .Cells(.Rows.Count, col).End(xlUp).Row End With End Function Invoices-j3_03-officena.xlsm

اخي الكريم لماذا لا تبحث في المنتدى اذا لم تجد تفاعل من الاعضاء حول موضوعك لا تعتمد كثيرا ان يقوم شخص بانشاء لك كود من الصفر (ابحث في المنتدى وقم بتطويع احد الاكواد بناء على احتياجاتك لان المنتدى تعليمي) جرب هذه المحاولة بالفلترة ( ملاحظة : اذا كانت البيانات ضخمة جدا عندها الفلترة تكون عديمة الجدوى) Sub FilterData() Dim startDate As Long, endDate As Long startDate = sheet2.Range("C2").Value endDate = sheet2.Range("C3").Value sheet2.Range("A6").CurrentRegion.ClearContents With sheet1.UsedRange .AutoFilter 1, ">=" & startDate, xlAnd, "<= " & endDate .SpecialCells(xlCellTypeVisible).Copy sheet2.[A6] .AutoFilter End With End Sub Search between two dates ‬.xlsm

وهل هذا صعب ان ترفق ملفك وتوضح ما الذي تريده بدلا من ارفاق ملفات الاخرين دون ان تسفيد منها اذا اردت ان يساعدك الاعضاء !!!!!

اخي الكريم كيف تطبق الكود على بيانات مختلفة في الموقع . وجب عليك تنزيل الملف الاصلي اذا كنت غير ملم ببعض الاشياء في VBA Excel لقد قمت ببعض التعديلات لا ادري اذاكنت تريد التطبيق على العمودين E,F وهذا ما فعلته في المرة القادمة وضح اين تريد تطبيق النتائج ليس مجرد تنزيل ملفين لا احد يقوم بتتبع الكود سطر بسطر حتى يعلم ما يفعله الكود . دائما ضع النتائج قبل وبعد حتى يستطيع الاعضاء من مساعدتك. تحياتي تكلفة.xlsm

مجرد فضول اختي الكريمة لماذا العمود F في الورقة Transaction البعض قيم مدخلة يدويا والبعض يحتوي على معادلات هل يتم ادخال الارقام يدويا ام يتم جلبها بواسطة المعادلات ؟

كيفية استخراجهم هل وضع اسماء الملفات داخل ملف اكسيل

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

@mohamedyoussef عذرا لا اقوم باي تعديل جديد كما موضح ذلك قي توقيعي . انتظر شخص اخر يقوم بتعديل متطلباتك الجديدة .

اعتقد من خلال نظرة سريعة على الكود تحتاج الى تخصيص اخر صف به بيانات بينما انت تقوم بحلقة تكرارية لصفوف فارغة لذلك سيكون بطيء لصفوف لا فائدة منها

جرب هذه المحاولة وضعها في موديول الورقة وليس موديول عادي . يمكنك تغيير المدى كما تشاء Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A2:A4")) Is Nothing Then If Target.Offset(, 2) = "" Then MsgBox " تاكد من مركز التكلفة " End If End Sub

@2saad لدي فضول اذا لم يكن لديك مانع ارسل لي رابط الموقع وما هو الذي تريد جلبه ؟ اذا استطعت ان اسحب بياناته سافيدك بذلك. تحياتي

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

اخي الكريم هذا موضوع مختلف لا يحتاج الى شخص لديه خبرة كبيرة حتى يصيغ السؤال بشكل جيد . عندما نرى اليوزرفورم لا يوجد زر هذا يعني تريد اظهار البيانات في اليوزرفورم وليس العكس كان عليك اختصار الامر بقول ترحيل البيانات من اليوزرفورم الى الشيت . الى هذا الحد صعب قول ذلك ؟؟؟؟؟ هذه مضيعة للوقت في المرة الاولى طلبت نفس الخلية B4 لكلتا الورقتين والان تغير الخلية . هل علينا ان نقوم بالتخمين ؟؟ قم بانشاء زر تحكم وضع هذا الكود وامسح الكود السابق . هذا الكود لورقة واحدة كما طلبت . Private Sub CommandButton1_Click() Dim sh1 As Worksheet Set sh1 = Sheets("sheet1") sh1.Range("B4").Value = TextBox1.Value sh1.Range("D5").Value = TextBox2.Value End Sub

بناء على طلبك ان لم اسيء الفهم الموضوع ليس بتلك التعقيد ضع هذا في موديول اليوزرفورم ..لا تنسى ان تكون تسمية الاوراق مطابقة كما في الكود Private Sub UserForm_Initialize() Dim sh1, sh2 As Worksheet Set sh1 = Sheets("sheet1") Set sh2 = Sheets("sheet2") TextBox1.Value = sh1.Range("b4").Value TextBox2.Value = sh2.Range("b4").Value End Sub

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

المهم الفكرة يجب عمل المصفوفة لاكثر من عشر اعمدة قم بتنفيذ هذه الفكرة على مشروعك .

هذا الموضوع متوفر في المنتدى فقط ابحث وستجده بدلا من تكرار نفس المواضيع https://www.officeforworld.com/2019/05/10-listbox-excel-vba.html

لماذا لا تقوم بتصميمها على الاكسيل بدلا من كل هذا التعقيد .