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

اقتباس

نعم سيدى حقاً ، تم التحقق فعلا من الملف 

لا  يجب  ان  تقول  اعتقد    ان لم  تكن  متاكدا

اقتباس

لم اقل ابدا انه مطلوب تنسيق من حضرتك قلت

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

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

اقتباس

لكن اتمني على حضرتك ان يكون اسلوبك بقدر خبرتك ، هون علي نفسك سيدى ان اتعبك الملف فلست ملزم بالمساعدة واهدار وقتك

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

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

اقتباس

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

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

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

 لن  ادخل  في  هكذا  مواضيع  في  المستقبل .

على اي  حال  لضيق  وقتي  هذه  محاولة  بخصوص  المطلوب  الاول  .  ولم  افهم  شيء  بخصوص  المطلوب  الثاني , وما  الهدف  منه ؟

كما  تلاحظ من  خلال  الكود  قمت  بتخصيص  الايام  بالعربي  لانه  تظهر  بالانجليزي  ( عندما  تتغير  القيم  في  خلايا  العمود 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  في الشيت الأول ، وما في التكست الثاني يترحل إلى D5 في نفس الشيت أو حتى في الشيت الآخر 

هذه مضيعة للوقت  في  المرة  الاولى  طلبت  نفس  الخلية 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

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

ارفق ملف  وليس صورة حتى نعلم ما الخطا الذي قمت به ٠