طارق محمود

السلام عليكم وبعد إذن الإخوة الأعزاء جميعا ولمزيد من الإثراء أخي العزيز ضع هذا الكود في حدث الورقة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count <> 1 Then Exit Sub With ActiveSheet.ListObjects(1) S_Rw = .Range.Row + 1 L_Rw = .ListRows.Count + S_Rw - 1 End With If Intersect(Range(Cells(S_Rw, 2), Cells(L_Rw, 2)), Target) Is Nothing Then Exit Sub Cells(Target.Row, "E") = Time Cells(Target.Row, "F") = Date End Sub يعتمد الكود علي أن يحدث تغيير في إحدي خلايا الجدول بالعمود B عندها يكتب أوتوماتيكيا قيمة الوقت والتاريخ في عموديهما لحظة هذا التغيير تفضل المرفق أيضا طلب دالة أو كود يثبت الوقت والتاريخ تلقائياً.rar

السلام عليكم رائع أخي العزيز / الزباري فككت طلسما كان يسبب مشاكل للعديد من الأعضاء جزاك الله خيرا

السلام عليكم أخي الكريم أرجو أن يكون المرفق هو ماتريد ملحوظة: صلحت لك شيئا يسيرا في المطلوب 12345_New.rar

أرجو أن تقرر ياأخي بعد الحذف يترحل باقي الجدول لأعلي أم لليسار

Cond-Format.rarالسلام عليكم مرفق حل ينبهك علي الخلايا التي طولها لايساوي 9 أو 12 بالتنسيق الشرطي Conditional Format أرجو أن يكون هو ماتريد وإلا إرفق أنت ملفا من عندك

أخي وحبيبي الغالي أبا البراء مشاركتك ومرورك علي مواضيعي شرف عظيم ولاداعي للتواضع ، إن كنت تصر علي موضوع الأستاذ والمعلم فأنا صدقا أراك قطعت شوطا كبيرا وأصبحت أفضل مني بكثير في الإكسل لك كل الحب والتقدير

وهذه الصورة لشرح كيفية فتح موضوع جديد

السلام عليكم ورحمة الله وبركاته جائني علي الخاص الرسالة التالية من أخونا الفاضل (رجب محمد) ===================================== عندي شيت اكسل يحتوي على بيانات اكثر من عشرين الف اسم وقد حاولت ان اطبع كل عشرين اسم في صفحة مستقلة الطريقة التي اتبعها دائما هو عمل بيج بريك للصفحة وظبط الهوامش كما تعلم حضرتك وهذا يتم في ملف صغير يحتوي على عدد قليل من الاسماء اما الملف الاكبر فقد تعبت فيه لان عند الطباعة يظهر في صفحة عدد مثلا ثلاثون وفي صفحة اخري خمسون هل هناك طريق بسيطة لعمل ذلك الرجاء الرد سريعا ولكم جزيل الشكر =================================== إنتهت الرسالة ولم يكن أخونا رجب يستطيع رفع الملف المهم نصحته باستخدام الكود التالي Sub Macro1() LR = Sheet1.[A99999].End(xlUp).Row For r = (15 + 19) To LR Step 20 ' يمكنك استبدال الرقم 15 برقم أول سطر بعد العناوين ActiveSheet.HPageBreaks.Add Before:=Cells(r, 1) Next End Sub وبعد إرسال الملف لي واستئذانه في نشره هذا هو الملف مرفق بعد عمل اللازم (ليس به معلومات تضر بمصلحة العمل) بيج بريك.rar

السلام عليكم اخى ياسر هديه قيمة شكر الله لك وبارك الله فيك تقبل تحياتى

السلام عليكم تجدون في المرفق ان شاء الله الأسماء كلها نصف يدوي كما اقترحت من قبل قد يكون مازال أخطاء بنسبة لن تتجاوز 1% انجاز اخر العام2.rar

شكرا أخي الحبيب / عمرو وحل كمان زيادة ممكن أيضا تستخدم ترجمة جوجول عالنت مباشرة إذا وضعت الأسماء كما هي في شاشاة ترجمة من اللغة العربية إلي أي لغة أخري تجد أن ترجمة جوجول تقترح عليك الأسماء المُعدلة أنظر الصورة

السلام عليكم الأفضل عملها نصف يدويا كالتالي مثلا إسم محمد إستخدم خاصية الاستبدال Ctrl-H مرتين المرة الأولي لاستبدال "محمد" بـ " محمد " أي تستبدله بما يزيد عليه بمسافة قبله ومسافة بعده وتكرر ذلك مثلا لكلمة "عبد" وأي إسم آخر تشتبه في أن به خطأ ثم المرة الثانية لاستبدال مسافتين متتابعتين" " بـمسافة واحدة" " أي تستبدل أي مسافتين متتابعتين في الشيت بمسافة واحدة =============== لاحظ أن عند استخدام المرة الأولي سينتج كثيرا من المسافتين المتتابعتين

السلام عليكم بعد إذن أخونا الغالي أبو إيمان تفضل المرفق بعد إضافة بيانات جديدة فقط إضغط زر "زيادة العامل" Paie_Personnels.rar

أين الملف المرفق

السلام عليكم بعد إذن أخي الغالي سليم تفضل الكود التالي (تعديلا علي الكود الذي أرسلته) يتم تفعيل الكود بالضغط علي الزر بعد تغيير الخليتين الحمراوين Sub FilterData() Dim jobs As String, cycl As String jobs = [B1].Value: cycl = [I1].Value On Error Resume Next ActiveSheet.AutoFilterMode = False With [B3:O999] .AutoFilter Field:=13, Criteria1:=cycl .AutoFilter Field:=14, Criteria1:=jobs End With End Sub تفضل الملف أيضا عمل SORT بناء على إختيارين.rar

السلام عليكم لم أفهم ماتريد بعمل sort لنتيجة البحث عمل sort علي أي أساس : الاسم المهنة الجنسية نتيجة الدورة عموما ، مرفق شرح بسيط للكود شرح الكود_احمد بهجت.rar

السلام عليكم تفضل المرفق التمرين.rar

تكون العمليه في نقل البيانات ثقيلة وبطيئة لأن ورقة الأرشيف بها 10 آلاف بيان مرفق الملف مرة أخري وبه ربط لكودي الإظهار والاخفاء BON4.rar

السلام عليكم تفضل اخي غير إسم العميل (في ورقة كشف حساب) وسيتم فرز بياناته من ورقة الأرشيف أوتوماتيكيا BON3.rar

السلام عليكم أخي العزيز تفضل المرفق وبه تعديل الكود لاحظت أنك أضفت أعمدة في ورقة الأرشيف وقد عدلت الكود أيضا ليناسب أرقام الأعمدة الجديدة تذكر أن الكود تم تفصيله علي هذا الشكل ولايجوز إضافة مثل هذه الأعمدة ، إلا إذا كنت تستطيع التعديل علي الكود الكود الجديد Sub Tarheel() LR = [A58].End(xlUp).Row If LR < 20 Then MsgBox "No data to shift": Exit Sub nm = [B11]: dt = [B17]: bil = [K11] Set Q_P = Union(Range("A20:A" & LR), Range("E20:E" & LR)) Set dsc = Range("B20:B" & LR) n = dsc.Count Sheets("الارشف").Activate nr = [E9999].End(xlUp).Row + 1 dsc.Copy Cells(nr, 7).PasteSpecial Paste:=xlPasteValues Q_P.Copy Cells(nr, 8).PasteSpecial Paste:=xlPasteValues Range("E" & nr & ":E" & nr + n - 1) = dt Range("F" & nr & ":F" & nr + n - 1) = nm Range("D" & nr & ":D" & nr + n - 1) = bil Sheets("bon de livraison ").Activate Set dsc = dsc.Resize(n, 3) dsc.Select dsc.ClearContents [B11:C11].ClearContents [B17].ClearContents Q_P.ClearContents [K11] = [K11] + 1 End Sub هل لاحظت مثلا أن Sheets("الارشف").Activate nr = [B9999].End(xlUp).Row + 1 dsc.Copy Cells(nr, 4).PasteSpecial Paste:=xlPasteValues Q_P.Copy Cells(nr, 5).PasteSpecial Paste:=xlPasteValues Range("B" & nr & ":B" & nr + n - 1) = dt Range("C" & nr & ":C" & nr + n - 1) = nm أصبحت Sheets("الارشف").Activate nr = [E9999].End(xlUp).Row + 1 dsc.Copy Cells(nr, 7).PasteSpecial Paste:=xlPasteValues Q_P.Copy Cells(nr, 8).PasteSpecial Paste:=xlPasteValues Range("E" & nr & ":E" & nr + n - 1) = dt Range("F" & nr & ":F" & nr + n - 1) = nm BON1.rar

السلام عليكم أخي العزيز تفضل المرفق وبه كود لعمل المطلوب الكود هو Sub Tarheel() LR = [A58].End(xlUp).Row If LR < 20 Then MsgBox "No data to shift": Exit Sub nm = [B11]: dt = [B17] Set Q_P = Union(Range("A20:A" & LR), Range("E20:E" & LR)) Set dsc = Range("B20:B" & LR) n = dsc.Count Sheets("الارشف").Activate nr = [B9999].End(xlUp).Row + 1 dsc.Copy Cells(nr, 4).PasteSpecial Paste:=xlPasteValues Q_P.Copy Cells(nr, 5).PasteSpecial Paste:=xlPasteValues Range("B" & nr & ":B" & nr + n - 1) = dt Range("C" & nr & ":C" & nr + n - 1) = nm End Sub ويتم تفعيله بالضغط علي زر ترحيل BON.rar

?????? أين الملف

السلام عليكم استخدم الدالة COUNTIF أنظر المرفق hafz.rar

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

وبتصليح طفيف في الدالة التي قدمها لنا أخونا الحبيب/ ياسر لأن بها نفس المشكلة تتصلح للتالي وقد جربتها وأعطت ناتج مضبوط Function VOL(Rad, Length, Height) Dim X, Y X = Application.WorksheetFunction.Acos((Rad - Height) / Rad) * 2 Y = Sin(X) VOL = Rad * Rad * (X - Y) /2* Length End Function