خالد الرشيدى

تنفيذ الكود يكون بتغيير احد القيم الموجوده بالصف او اضافه قيمة جديده بحيث عند تحديث البيانات ينفذ الكود بشكل تلقائي بمعني لو قمت بتغيير قيمة الخليه E3 تقع بالصف الثالث ومن ثم يتم التجميع في A3 .. او قم بتغيير قيم العمود E او F او G h او ................ ولاحظ النتائج ويمكن جعل تنفيذ الكود من خلال زر لو اردت ذلك

اخي الكريم الملف والكود يعمل بشكل دقيق تماماً راجع المرفق Employee.rar

بالفعل هو ده الكود الى بيعمله !!!! راجع الملف بشكل جيد بالنسبه للجزئيه التانيه استبدل الكود بهذا الكود Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Column <> 1 And Target.Column <> 2 And Target.Column <> 3 And Target.Column <> 4 Then Dim Lc As Long, r As Variant, i As Integer Lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column For i = 5 To Lc r = r & Cells(Target.Row, i).Value & " " Next r = Join(Split(Trim(r)), " - ") Cells(Target.Row, 1) = r End If End Sub

تم تعديل الكود ليناسب ملفك الاصلى مع مراعاه الاتى .. حضرتك عامل امود من شأنها ان تجعل الكود يقرأ الفراغات وكأنها قيم .. لا تجعل هناك مسافات قبل القيم او بداخل الخلايا الفارغة فلا قيمه لها ويمكنك ان تستخدم التنسيقات لجعل القيم في وسط الخلايا Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Column <> 1 And Target.Column <> 2 And Target.Column <> 3 And Target.Column <> 4 Then Dim Lc As Long, r As Variant, i As Integer Lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column For i = 5 To Lc If Cells(Target.Row, i) <> "" Then r = r & Cells(Target.Row, i).Value & " " End If Next r = Join(Split(Trim(r)), " - ") Cells(Target.Row, 1) = r End If End Sub Employee.rar

اخي الكريم جرب الكود التالى.. ضف في عدد الاعمده كما تشاء .. Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next ' اذا حدث وان تم تغيير قيم احد خلايا العمود الاول او الثاني او الثالث If Target.Column = 1 Or Target.Column = 2 Or Target.Column = 3 Then Dim Lr As Long, r As Variant ' هنا ايجاد رقم اخر صف به بيانات حيث العمود الذي توجد به الخليه التى تم تغيير قيمتها Lr = Cells(Rows.Count, Target.Column).End(xlUp).Row 'Lr حلقه تكرارية للمرور على كافة صفوف هذا العمود بدءاً من الصف السسادس وحتى الصف الاخير For i = 6 To Lr 'r تخزين قيم هذا الصف داخل المتغير r = r & Cells(i, Target.Column).Value & " " Next ' - الفصل بين قيم المتغير ب r = Join(Split(Trim(r)), " - ") ' اهنا وضع الناتج داخل الخلية الموجوده بالصف 5 والعمود الذي به الخليه التى تغيرت قيمتها ' +3 ' وطبعاً ده متناسب مع هذا الملف وعليك التغيير بما يتناسب مع ملفك الاصلي Cells(5, Target.Column + 3) = r End If End Sub Book1.rar ولكن اخر سطر بالكود سيتوجب عليك تعديله بما يتناسب مع ملفك الاصلي حيث : Cells(5, Target.Column + 3) بافتراض انك قمت بتغيير قيمه A10 عندها سيكون السطر السابق هكذا Cells(5, 1 + 3) مما يعني الخليه الموجوده بالصف الخامس والعمود رقم 4 ( 3 + 1 ) اى الخليه D5

السلام عليكم هذه الملاحظات جميعها يستدعي تغيير الاكواد المستخدمة ... فلا تدع الامر مفتوحاً هكذا ... ارسل ملف به امثله للحالات المختلفة التى تحتاجها للعمل عليها تقبل مرورى وتحياتى

السلام عليكم انظر المرفق عله المطلوب student.rar

جزاك الله خيراً اخي الكريم على هذا الدعاء الطيب وجزالك الله بمثله ان شاء الله الحمد لله ان تم المطلوب .. الحمد لله الذي بنعمته تتم الصالحات

السلام عليكم جرب الكود التالى Book1.rar

السلام عليكم هناك العديد جدا من الطرق .. اليك =VLOOKUP(C5,IF(المصروف!$F$5:$F$10=الموقف!D5,المصروف!$E$5:$G$10,""),3,FALSE) و =INDEX(المصروف!$E$5:$G$10,MATCH(1,(المصروف!$E$5:$E$10=الموقف!C5)*(المصروف!$F$5:$F$10=الموقف!D5),0),3) و =VLOOKUP(C5&D5,IF({1,0},المصروف!$E$5:$E$10&المصروف!$F$5:$F$10,المصروف!$G$5:$G$10),2,0) معادلات صفيف بعد كتابتها يتم الضغط على CTRL + SHIFT + ENTER معادلة على اساس شرطين الرقم والتاريخ.rar

اخي الكريم بالمعادلات ومع هذا الكم من البيانات لا اعتقد يسهل ذلك.. كما سبق وان اشار الموضوع علي الرابط.. خصوصا وان حضرتك تريد وضع فواصل.. لذلك عليك استخدام الماكروا في هذه الحاله ولعلم حضرتك ان الماكروا اسرع بكثييير جدا من المعادلات.. بل بالعكس.. ما يسبب ثقل الملف وبط التنفيذ هو كثره المعادلات وايضا الماكروا الغير احترافي.. الذي يسجل من خلال ايقونه record macro. لانه في كثير جدا من الاحيان ينفذ امور كثيره لا قيمه لها.. وذلك يرجع الي انه يسجل كل حركه يقوم بها المستخدم اثناء التسجيل .. الان انت بحاجه الي كود .. ينفذ في حدث اضافه بيانات جديده.. بحيث لا تكون بحاجه الي الضغط علي زر عندما تضيف بيانات لكي تحدث البيانات بالخليه ... ساقوم بالعمل عليه في اقرب فرصه.. او ان يقدمه لحضرتك احد اساتذتي ويفضل ان تفتح موضوع جديد بهذا الامر تقبل مروري وتحياتي

اخي الكريم افتح الرابط التالي... يعرض مختلف الحالات المتاحه حول هذا الامر https://www.excelcampus.com/keyboard-shortcuts/concatenate-range-of-cells/ مع العلم انه .. ليس شرطاً تنفيذ الماكروا من خلال زر .. من الممكن عمل ماكروا ينفذ بمجرد ادخال اى قيمه جديده بالعمود A وبالتالى طريقة التنفيذ ستكون مماثله لطريقة تنفيذ المعادلات .. راجع الامر وحدد المطلوب تقبل مروري وتحياتي

السلام عليكم اهلا بك اخي الكريم بين إخوانك بالمنتدي قم برفع ملف مبسط مشروح فيه المطلوب بشكل تفصيلي تقبل مرورى وتحياتى

السلام عليكم تفضل اخي الكريم علة المطلوب تماماً Sub Add() Dim LR, LE As Long '=========================================================== Dim sh1 As Worksheet: Set sh1 = Sheets("بيانات اساسية") Dim sh2 As Worksheet: Set sh2 = Sheets("كشف") LE = sh1.Cells(Rows.Count, "Q").End(xlUp).Row ' sh1 بشيت Range("B6:B" & LE) بدلاله النطاق A1 عدد مرات تكرار اسم الكشف الموجود في شيت كشف خليه If Application.WorksheetFunction.CountIf(sh1.Range("B6:B" & LE), sh2.Range("a1").Value) > 29 Then MsgBox "لا يمكن استدعاء كل البيانات " ' تفريغ نطاق نتيجة البحث بشيت كشف sh2.Range("B6:BH35").ClearContents ' انهاء عمل الكود Exit Sub End If ' ان لم يتحقق الشرط السابق بحيث عدد النتائج اقل من او يساوي 29 ' تفريغ نطاق نتيجة البحث بشيت كشف ' بحيث يهيأ لاستقبال النتائج الجديده فى كل مرة sh2.Range("B6:BH35").ClearContents '=========================================================== ' وقف اهتزازات الشاشة اثناء عمل الكود Application.ScreenUpdating = False '=========================================================== Dim cll As Range 'sh1.Range("B6:B" & LE) عمل حلقة تكرارية - ساقية - علي كل صفوف النطاق For Each cll In sh1.Range("B6:B" & LE) 'sh2.Range("A1") لو ان قيمتها تساوي قيمة الخلية If cll.Value = sh2.Range("A1").Value Then ' انسخ الصف الذي تحقق به الشرط sh1.Range("Q" & cll.Row & ":BX" & cll.Row).Copy 'شيت كشف B لصق الصف في اول خليه فارغة في العمود sh2.Range("B" & sh2.Range("B35").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues ' انتهي الشرط End If ' نقطه بدء ونهاية الساقيه لحين الانتهاء من الدوران على كافة الصفوف المحددة Next ' ازالة التحديد عن النطاق المنسوخ Application.CutCopyMode = False ' اعادت تحديثات الشاشه Application.ScreenUpdating = True End Sub تفضل المرفق استدعاء بيانا_2.rar

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

السلام عليكم جزاك الله خيراً اخي الكريم وننتظر منك المزيد من المشاركات والمساهمات بالموقع تقبل مرورى وتحياتى

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

اخي الكريم على الرغم من ان هناك امور غير واضحه .. مثل لو عددهم 29 لا يتم الترحيل .. وايضاً انت بتجيب رقم الصف الفارغ بشيت الكشف بدءاً من B35 صعوداً لاعلى وبذلك تجاهلت باقي الصفوف التى هي اسفل منها .. ومع ذلك اليك الطريقة وعليك التعديل بما يناسبك فيما يتعلق بالجزئيتين السابقتين استدعاء بيانا_2.rar ( تم الغاء دمج الخلايا B3:B5 لانه من شأنه ان يفسد عمل الكود .. يمكنك ان تدمج B3:B4 ولكن ضع اى قيمه في B5 ولو بشكل مخفي بحيث تكون القيمة بلون ارضيه الخلية ) تقبل خالص تحياتى

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

اخي الكريم اكواد وضع التسلسل والتاريخ إما قبل زر ترحيل بيانات أو بعده لعمل تحديث للقيم .. لهذا الخطأ يكمن فى الزر .. لانه لو يقوم بترحيل القيم الى شيت السجل عندها يرحل 118 ثم يظهر بالفاتورة 119 لانه الكود يقرأ اكبر رقم فى العمو A ويضيف له 1 ... ولكن لان الزر لا يرحل القيم الى شيت السجل لهذا اخر رقم هو 117 و يظهر بالفاتورة 118 ولن يزيد عن ذلك .. (ما المفترض ان يقوم به الزر وصل فانا لا اتذكر كما انى لست امام الكمبيوتر )

اخي الكريم .. اي نطاق تريد سحب التسلسل منه... بالحل السابق التسلسل يتم بناء علي العمود الاول من صفحه السجل.. اي نطاق تريد اكبررقم فيه +1

السلام عليكم جرب المرفق علة المطلوب اعطاء رقم فاتور ة تلقائي.rar

اخى الكريم اذا كانوا ثلاثه فالامر بسيط ويمكن تعديل المعادلة لتفادي الخطأ السابق ... ولو اكثر قليلاً جداايضا يمكن ذلك .. ولكن طالما قد يصلوا الى 1000 اذاً اعتقد انت بحاجه الى الاطلاع الى هذا الرابط http://www.get-digital-help.com/2010/01/05/identify-numbers-in-sum-using-solver-in-excel/ تقبل مرورى وتحياتى

شكراً جزيلاً علي هذا الدعاء الطيب جزاك الله خيراً الحمد لله الذي بنعمته تتم الصالحات

السلام عليكم اخي الكريم هل القيم دائما ثلاثه ارقام.. ام قد يكونوا اكثر من ذلك