saad abed

استاذى الكبير العلامة // عبدالله باقشير حفظكم الله ** رعاكم الله اسال الله ان يبارك فيكم شرف كبير ان ترد على اى موضوع لانك استاذى الذى اتتبع ردوده وخطواته بارك الله فيكم تخياتى

اخى ابراهيم ابوليلة ربما لا اجيد الشرح لانى لا زلت تلميذ ولكن طلبك غالى اخى الكريم سيكون الشرح بعد سرد الكود Sheets("Sheet1").Select Sheets("Sheet1").Range("f3:h3000").ClearContents Application.ScreenUpdating = False Application.Calculation = xlCalculationManual السطر الاول اثرت ان اختار الورقة التى اعمل عليها السطر الذى يليه الهدف منه وقف اهتزاز الشاشة السطر االتالى هو وقف الحساب التلقائى فى الاكسيل الهدف من السطرين ان يكون نقل البيانات والبحث عن الشروط بسرعة For i = 3 To Range("c3").End(xlDown).Row بداية جمل الدوران تبدا من السطر الثالث وتنزل الى اخر سطر فى العمود c وطبعا تنتهى next كل هذا لم تبدا فكرة الكود ستبدا بدالة if If condition then Statement 1 Statement 2 … .... End if If Sheets("Sheet1").Cells(i, 3) = Cells(2, 6) Then Sheets("Sheet1").Cells(i, 6) = Sheets("Sheet1").Cells(i, 2) الشرط هنا ان تتساوى قيم العمود الثالث مع الخلية الموجودة بالصف الثانى والعمود السادس المطلوب تنفيذه هو نقل القيم التى تتساوى بها فى العمود الثانى الى العمود السادس ثم وجدت مشكلة وهى القيم تنقل فى نفس الاماكن فوجدت وجود خلايا فارغة فوجدت الحل فى الغاءها Range("f3:h300").SpecialCells(xlCellTypeBlanks).Delete وكررت الموضوع ثلاث مرات ثم ارجعت الاعدادات الى ما كانت عليه ارجو ان اكون وفقت تحياتى

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

استاذى ابراهيم ابوليلة استاذى حمادة باشا انا اعلم انكم اساتذة عظماء احاول ان تراجعوا اكوادى لانى احاول رد جميل هذا الصرح العظبم استاذنكم ان اشارككم الاراء والحلول Sub gggg() Sheets("Sheet1").Select Sheets("Sheet1").Range("f3:h3000").ClearContents Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = 3 To Range("c3").End(xlDown).Row If Sheets("Sheet1").Cells(i, 3) = Cells(2, 6) Then Sheets("Sheet1").Cells(i, 6) = Sheets("Sheet1").Cells(i, 2) End If If Sheets("Sheet1").Cells(i, 3) = Cells(2, 7) Then Sheets("Sheet1").Cells(i, 7) = Sheets("Sheet1").Cells(i, 2) End If If Sheets("Sheet1").Cells(i, 3) = Cells(2, 8) Then Sheets("Sheet1").Cells(i, 8) = Sheets("Sheet1").Cells(i, 2) End If Range("f3:h300").SpecialCells(xlCellTypeBlanks).Delete Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub استخراج.rar

اخى ابراهيم ابوليلة السلام عليكم هل تريد الارقام فى العمود Bا لتى تقابل الكلمة فى العمود c حتى لو كانت مكرره اكثر من مرة ام لم تصل الى الفكرة

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

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

اخوتى هل هناك مشكلة فى المنتدى اين المواضيع المثبته ومواضيع اخرى هل من تفسير

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

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

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

اخى ابوحنين بعد ما قرات ردكم تمنيت ان كل عربى او كل مسلم او كل انسان على هذه الارض ان يقرأها جزاك الله خيرا

اخى الحبيب ابوحنين اضافاتك واكوادك اكتبها واسجلها لاتعلم منها جزاك الله كل خير ولى الشرف وافتخر انك احد الاساتذه الذين اسجل اكوادهم لا اتعلم منها كيف افكر فى بناء الكود تحياتى لكم

استاذ جمال استاذ رجب جاويش جامعة اوفيستا تمتلك مشرفين عظماء علما واخلاقا وفقكم الله

أستاذنا الكبير الحاج // مجدى بارك الله فيك وننتظر البرامج تقبل تحياتى

اخى محمود تم تعديل الكود جرب واعلمنى تحياتى Sub saad() Application.ScreenUpdating = False Sheets("Entry").Select al = Sheets("Database").[e10000].End(xlUp).Row If [d1] = "" Or [d2] = "" Or [d3] = "" Then MsgBox "Ãßãá ÇáÈíÇäÇÊ ÃæáÇ" Exit Sub ElseIf Not [c4].Value = [d4].Value Then MsgBox "!ÊÃßÏ ãä ÅÏÎÇá ÇáÞíÏ ãÚ ÊæÇÒä ÇáØÑÝíä", vbExclamation, "ÅÏÎÇá ÎÇØÆ" Exit Sub ElseIf Sheets("Database").Range("e" & al).Value = [d2].Value Then MsgBox "!ÊÃßÏ ãä ÚÏã ÊßÑÇÑ ÇáÝíÏ", vbExclamation, "ÅÏÎÇá ÎÇØÆ" Exit Sub 'Else End If For r = 7 To Sheets("Entry").[c3000].End(xlUp).Row With Sheets("Database").[d10000].End(xlUp) .Offset(1, 0) = Sheets("Entry").[d1].Value .Offset(1, 1) = Sheets("Entry").[d2].Value .Offset(1, 2) = Sheets("Entry").[d3].Value .Offset(1, 3) = Sheets("Entry").Cells(r, 3) .Offset(1, 4) = Sheets("Entry").Cells(r, 4) .Offset(1, 5) = Sheets("Entry").Cells(r, 5) .Offset(1, 6) = Sheets("Entry").Cells(r, 6) End With Next r Application.ScreenUpdating = True End Sub مثال على الترحيل.rar

اخى جرب المرفق لعله المطلوب حذف محتوى خلاي في الصفوف.rar

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

اللهم اجمع كلمة المسلمينواحمهم يارب من كيد الكائدين اللهم امين

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

اخى عادل بعد اذن السادة الحضور هذا حل بالاكواد جرب واعلمنى دمتم بخير saad.rar

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

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

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

استاذى رجب ابلغ رد اقثبسته من ا/سعيد جزاك الله خيرا