كود عمليه ضرب

[ياسر فاروق]

الساده

السلام عليكم ورحمة الله وبركاته

المرفق كود عمليه ضرب عمودين ووضع الناتج فى العمود الثالث من احد الساده الافاضل بالموقع

وأريد شرح لخطوات الكود حتى أستطيع الاستفاده منه فى ملف أخر ولكن مسمى الأعمدة مختلفة

Sub BOQ()
   
    For s = 1 To Sheets.Count
        Sheets(s).Select
        x = Cells.SpecialCells(xlCellTypeLastCell).Row
        For r = 8 To x
            If IsNumeric(Cells(r, "I")) = False Then Cells(r, "F").FormulaR1C1 = "=RC[2]*RC[4]"
        Next r
    Next s
End Sub

 

وشكرا

[ياسر فاروق]

الساده

السلام عليكم ورحمة الله وبركاته

المرفق كود عمليه ضرب عمودين ووضع الناتج فى العمود الثالث من احد الساده الافاضل بالموقع

وأريد شرح لخطوات الكود حتى أستطيع الاستفاده منه فى ملف أخر (اختلاف الأعمدة )

Sub BOQ()
   
    For s = 1 To Sheets.Count
        Sheets(s).Select
        x = Cells.SpecialCells(xlCellTypeLastCell).Row
        For r = 8 To x
            If IsNumeric(Cells(r, "I")) = False Then Cells(r, "F").FormulaR1C1 = "=RC[2]*RC[4]"
        Next r
    Next s
End Sub

[ياسر فاروق]

الساده

السلام عليكم ورحمة الله وبركاته

المرفق كود عمليه ضرب عمودين ووضع الناتج فى العمود الثالث من احد الساده الافاضل بالموقع

وأريد شرح لخطوات الكود حتى أستطيع الاستفاده منه فى ملف أخر (اختلاف الأعمدة )

Sub BOQ()
   
    For s = 1 To Sheets.Count
        Sheets(s).Select
        x = Cells.SpecialCells(xlCellTypeLastCell).Row
        For r = 8 To x
            If IsNumeric(Cells(r, "I")) = False Then Cells(r, "F").FormulaR1C1 = "=RC[2]*RC[4]"
        Next r
    Next s
End Sub

[Ali Mohamed Ali]

وعليكم السلام

بالملف موجود كود لحاصل ضرب العمودان C & D واخراج الناتج فى العمود E

Sub Test()
  Dim LR As Long
  LR = Range("C" & Rows.Count).End(xlUp).Row
  Range("E1:E" & LR) = Evaluate("C1:C" & LR & "*D1:D" & LR)
End Sub

 

كود ضرب.xlsm

[ياسر فاروق]

أ/ ali mohamed ali

السلام عليكم ورحمة الله وبركاته

أشكرك على اهتمامك والاستجابة

برجاء شرح خطوات الكود

بسبب وجود جداول تتغير فيها أحرف الاعمدة

وهل الكود يعمل على كل الشيتات الموجوده بالملف

وشكرا مره اخرى

[Ali Mohamed Ali]

طبعا يمكن العمل فى كل صفحة ولكن لابد من ربطه بزر

Sub Test()
'بداية الكود
  Dim LR As Long
'تحديد LR كمتغير الى اخر سطر به بيانات
  LR = Range("C" & Rows.Count).End(xlUp).Row
  Range("E1:E" & LR) = Evaluate("C1:C" & LR & "*D1:D" & LR)
'حاصل ضرب العمود C مع العمود D
'واخراج الناتج فى العمود E
End Sub
'نهاية الكود

 

 

[ياسر فاروق]

أ/ ali mohamed ali

السلام عليكم ورحمة الله وبركاته

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

وأزيد من علمك

أن تجعل الكود يعمل على كل الشيتات الموجوده بالملف مره واحده دون المرور على كل شيت

وشكرا مره اخرى

[Ali Mohamed Ali]

ولكى يعمل هذا الكود معك فى كل صفحة جديدة تفتحها داخل الملف 

لابد من وضع هذا الكود فى حدث This WorkBook

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call Test
End Sub

 

 

 

كود ضرب.xlsm

[ياسر فاروق]

أ/ ali mohamed ali

السلام عليكم ورحمة الله وبركاته

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

وتم تجربته وأدى ما كنت أبحث عنه بفضل مساعدتك والاستاذ الفاضل (صاحب الكود)

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

هل تستطيع مساعدتى فى عمل كل هذا عن طريق VBA

Sub Test()
For s = 1 To Sheets.Count
         Sheets(s).Select
  Dim LR As Long
  LR = Range("C" & Rows.Count).End(xlUp).Row
  Range("i1:i" & LR) = Evaluate("C1:C" & LR & "*D1:D" & LR)
Next s
 End Sub
وشكرا مره اخرى

B01.rar