سليم حاصبيا

الكود المظلوب Private Sub TextBox13_Change() Dim sh As Worksheet Set sh = Sheets("الاصناف") Dim i As Long, x As Long, p As Long, k As Byte Dim F_rg As Range, Rg_b As Range p = sh.Cells(Rows.Count, 2).End(3).Row Set Rg_b = sh.Range("b3:B" & p) Me.ListBox1.Clear Set F_rg = Rg_b.Find(Me.TextBox13, lookat:=1) If Not F_rg Is Nothing Then x = F_rg.Row With Me.ListBox1 .AddItem For k = 0 To 5 .List(.ListCount - 1, k) = _ sh.Cells(x, k + 2) Next End With End If End Sub الملف مرفق My_fatoura.xlsb

جرب هذا الكود Sub get_data() Dim rg As Range Dim ro Sheets("AddShe").Range("A1").CurrentRegion.ClearContents Set rg = Sheets("DatabaseShe").Range("a1").CurrentRegion Sheets("AddShe").Range("A1"). _ Resize(rg.Rows.Count, rg.Columns.Count).Value = _ rg.Value Sheets("AddShe").Range("A1"). _ CurrentRegion.Sort key1:=Range("B2"), Header:=1 ro = Sheets("AddShe").Range("a1").CurrentRegion.Rows.Count Sheets("AddShe").Range("A2").Resize(ro - 1) = _ Evaluate("row(1:" & ro - 1 & ")") End Sub الملف مرفق Saleh.xlsm

للمرة الألف عدم استعمال الخلايا المدمجة لأنها تسبب مشاكل في الكود جرب هذا الملف BADAWI.xlsm

جربي هذا الملف لا ضرورة لادراج التسلسل لان الكود يدرجه اوتوماتيكياُ في كل صفحة جسب احر رقم موجود فيها الأعمدة التي تحتوي على مغادلات تم اخفائها (في الشيت Main فقط) لعدم العبث بها عن طريق الخطأ أثناء كتابة البيانات (المعادلات محمية ضد الكتابة عليها) المعادلات في الشيت Main فقط الماكرو يقوم بنقل قيمها فقط الى الشيت التي اخترتها) لذلك لا حاجة لادراحها في كل شيت لا تقومي بحذف البيانات (من خلال تجدديد الصف بأكمله تم Delete )لأن ذلك يمسح المعادلات في الأعمدة التي تحتويها (H,Y,AM.AN) تم التعديل على المعادلات لعدم ادراج الأصفار والأخطاء يمكنك تصحيح الاخطاء في الخلايا التي لا تحتوي على معادلات /// كل الأعمدة ما عدا (H,Y,AM.AN) //// هذه الاعمدة مخفية لا تعملي Select يمس بها ثم Delete ) الزر Clear data يمسح كل شيء ما عدا المعادلات يمكن استعماله متى تريدين الملف مرفق ي Om_hamza.xlsb

اين الملف للعمل عليه؟؟؟ وهل تريدين ان تمسح البيانات من الشيب Main يعد الترحيل؟؟

ليس عملي ان أبحث عن محمد 1 أو محمد 2 الخ... كي اكتشف في اي عامود موجودين كي اضع رقم هذا العامود في الكود قدمت لك نموذج ابسط بكثير من اليوزر للعمل عليه ولا أعرف لماذا هذا الاصرار على اليوزر مع اني لا أطيقه ولا أحب العمل عليه فكيف كي ان اضع فيه اكثر من 40 كود (20 للتكست بوكسات و 20 للكومبوبوكسات) بالاضاقة الى أكواد الأزرار أعتذر عن المساعدة بهذا الشأن فالمنتدى تعليمي و ليس لوضع البرامج الجاهزة

لا يهمني ما يوجد في العامود (المطلوب اسمه و رقمه)

عن ماذا ارد ( تصميم الملف خطأ) لا يغمل عليه الكود اذا اردت عملاً جيداً انسخ مغطياتك الى الملف الذي رفعته لك واعمل عليه

أظن اته لا حاجة الى اليوزر و مشاكله اذا استعملتي هذا النموذج 1- أضيفي الى الشبت ما تريدين من الأعمدة مع عناويتها 2- تعبئة البيانات في الصفحة Main (يمكن تعبئة صف واحد أو عدة صفوف دفعة واحدة ) ليس كما في اليوزر 3- تحددين الورقة التي سيتم الترحيل اليها من الصفحة Main ( القائمة المنسدلة الحمراء) 4- تضغطين على الزر Run الكود Option Explicit Sub transfere_data() Dim M As Worksheet Dim sh As Worksheet Dim Rg As Range Dim ALL_Rg As Range Dim Max_ro% Set M = Sheets("Main") If M.Range("G2") = vbNullString Then Exit Sub Set sh = Sheets(M.Range("G2") & "") Max_ro = sh.Cells(Rows.Count, 2).End(3).Row + 1 If Max_ro <= 3 Then Max_ro = 4 Set Rg = M.Range("B3").CurrentRegion If Rg.Rows.Count = 1 Then Exit Sub Set Rg = Rg.Offset(1).Resize(Rg.Rows.Count - 1) Rg.Copy sh.Cells(Max_ro, 2).PasteSpecial (12) Set ALL_Rg = sh.Range("B3").CurrentRegion If ALL_Rg.Rows.Count > 1 Then sh.Range("A4").Resize(ALL_Rg.Rows.Count - 1) = _ Evaluate("row(1:" & ALL_Rg.Rows.Count - 1 & ")") End If Application.CutCopyMode = False End Sub الملف مرفق Omhamza.xlsm

1- هناك خطأ فب تصميم اليوزر قمت بتسمبة المبلغ في ListBox والمفروض TextBox كما في الصورة 2- ما هي أرقام الأعمدة (1 2 3....الخ) أو أسمائها ( AB M B A الخ....) من بين 30 عامود فهل تريدين ان نفتش عنها

قلت لك سابقاً ممنوع دمج الخلابا (ثم ما هذا التاريخ 1/1/1900 في الخلية D3 الذي يرجعنا 120 سنة الى الوراء)

جرب هذا الملف لا يتم ترحيل الفاتورة من الشبت Main الى الشيت Fatura أكثر من مرة واحدة اذا كانت مكررة (الاسم الأرقام والتاريخ) Hasan_Fatura.xlsm

تفضل يا صديقي قدر الامكان تجنب الخلايا المدمجة حبث يوجد معادلات اكنب الاسم في الخلية G3 ولو كنت تراه في H3 Hasan.xlsx

ترفع ملفاً فارغاً (سطربن من البيانات) وتطلب معالجته

ومن يعمل على جداول فارغة؟؟؟؟

اليك هذه الاضافة الى الملف (عسى ان تنال الاعجاب) ايجاد pos_sum و Neg_sum و All_sum بين تاريخين في صفحة واحدة "Test_All" Yara_All_In_One.xlsm

اضيقي الى القائمة النتسدلة عنصر تحت اسم sum15 و عدلي على الكود كما في الصورة الملف Yara_15_Part_Pos_Neg_All.xlsb

جرب هذا الملف تم وضع الضريبة في خلية مستقلة (B1) ربما طرأ نعديل عليها (افضل من تعديل كل المعادلات) لا يتم نلوين الصف الا اذا اكتملت عناصره ( 8 أعمدة غير فارغة من A الى H ) Fatura.xlsx

كان يجب ادراج ملف للمعاينة والمعالجة لكن حبث انك عضو جديد فأهلاً وسهلاً جرب هذا الملف(نموذج عمّا تريد) Shaban ebaid.xlsx

كان لازم من الأول كده (تعذيل الى هذا السطر) Part_sum = Round((Sum_pos * 0.85) + Sum_Neg, 2) Yara_Exacte.xlsb

اليك مثال عما استطعت ان أجده الأعداد الموجبة (حسب التاريخ) 75 و 25 مجموعها 100 %85 منها 85 الأعداد السالبة (حسب التاريخ) 10 - النتيجة 85+(-10) = 85-10 = 75 (تأكدي بنفسك من الباقي يدوياً)

ما أفصدة موجود في هذا الملف الذي يظهر النتيجة نفسها بالنسبة للأعداد (Pos=100,Neg=-10) النتيجة 75 كما تريدين حيث ان Neg هي نفسها سالبة لذلك يجب حمعها وليس طرحها لانه في حال طرحها تصبح -(-10) اي + 10 Explain.xlsx

التعديل استبدال المربع الاحمر بالأزرق مع التركيز على اشارة الــ + ( لأن Sum_ng هي سالبة)

استبدلي في القائمة المنسدلة عبارة nagative-positive-nagative*15/100 بكلمة Part وأضيفي الى الكود كما في الصورة في المكان المناسب الملف مرفق Yara_Part_Pos_Neg_All.xlsb

الـ current region هو النطاق الذي يمكنك التنقل به من أول خلية الى اخر خلية دون المرور بصفوف (أو أعمدة ) فارغة الخلايا الفارغة ضمن المربع الأحمر (مثلاً B3 ) هي ايضاً ضمن الـــcurrent region لانه يمكن الوصول اليها بنفس الشرط بينما الخلية E2 لا تحتسب ضمن current region لان العمود D فارغ و كذلك الخلية A7 لا تحتسب ضمن current region لان الصف 6 فارغ باختصار يمكن اعتبار الـــ current region مثل جزيرة في البحر يمكن ان يكون فيها شجر او سكان (الخلايا المليئة) و يمكن ان يكون فيها (لكن ليس كلها) مناطق خالية (الخلايا الفارغة) و عليك التنقل في ارض هذه الجزيرة دون أن تدوس بمياه البحر والـــ used range هو مجموعة من هذه الجزر لكل منها current region خاص بها يمكن تحديد current region بتحدبد اي خلية داخله والضغط على (Ctr+A) مرة واحدة و هذا جواب لماذا لا يعمل على جدول فارغ الصورة توضح ذلك