تعديل كود استدعاء اخر خلية الى خلية اخرى في اكثر من صفحة

[حسين مامون]

السلام عليكم

اساتذتنا في المنتذى الجميل

طلبي هو تعديل الكود في المديول الموجودفي الملف على جميع الصفحات باستثناء  الرئيسية و طباعة

عمل الكود الان هو استدعاء اخر خلية في العمود D  صفحة ياسر  الى الخلية H4  

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

جزاكم الله خيرا

الانخراط بالتقسيط.rar

تم تعديل يوليو 27, 2017 بواسطه حسين مامون

[سليم حاصبيا]

يلزمك هذا الماكرو

Option Explicit
Sub Salim()

Dim Ws As Worksheet, x%, lr%, k%, My_Rg As Range
k = Sheets.Count
For x = 2 To k - 1
Set Ws = Sheets(x)
 With Ws
    lr = .Cells(Rows.Count, "d").End(xlUp).Row
    Set My_Rg = .Range("d9:d" & lr)
           With .Range("h3")
               .Value = Application.Sum(My_Rg)
               .Offset(1) = Range("d" & lr)
           End With
 End With
Next
End Sub

 

[حسين مامون]

يشرفني مرورك استاذ سليم

 اخر خلية في بعض الصفحات لا تطلع صحيحة في h4

تحياتي

[سليم حاصبيا]

8 دقائق مضت, حسين مامون said:

يشرفني مرورك استاذ سليم

 اخر خلية في بعض الصفحات لا تطلع صحيحة في h4

تحياتي

لا اعلم السبب عندك لكن عندي يعمل بكفاءة

انظر المرفق

 

 

taksit.rar

[حسين مامون]

اضف بيانات في العمود d وانضر صفحة امجد و فارس

[حسين مامون]

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

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

باستثناء  الرئيسية و طباعة

هو ما اريد بالظبط

فقط اريد لمستكم  ورأيكم في الكود 

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

تحياتي لجميع الاساتذة

 

الانخراط بالتقسيط.rar

تم تعديل يوليو 27, 2017 بواسطه حسين مامون

[حسين مامون]

استاذ سليم ... بعد ما فهمت الكود الذ ارسلته في المشاركة السابقة وجدت ان سبب المشكلة في هذا الجزء
.Offset(1) = Range("d" & lr)

اظنك نسيت كتابة  WS بعد = 

المهم الكود يعمل بكفاءة وهو خفيف جدا  

السطر المذكور بعد التعديل  Offset(1) = ws. Range("d" & lr)

ارجو ان تقبل اعتداري

جزاك الله خيرا استاذ سليم 

 

[سليم حاصبيا]

48 دقائق مضت, حسين مامون said:

استاذ سليم ... بعد ما فهمت الكود الذ ارسلته في المشاركة السابقة وجدت ان سبب المشكلة في هذا الجزء
.Offset(1) = Range("d" & lr)

اظنك نسيت كتابة  WS بعد = 

المهم الكود يعمل بكفاءة وهو خفيف جدا  

السطر المذكور بعد التعديل  Offset(1) = ws. Range("d" & lr)

ارجو ان تقبل اعتداري

جزاك الله خيرا استاذ سليم 

 

لا يأس كخطوة أولى   لكن لدي 3 ملاحظات

1- تعريف المنغيرات بهذا الشكل

Dim ws As Worksheet, x, lr, xx

يثقل الملف لان اكسل يعتبر ان Ws هو المتغير الوحيد كصفحة عمل و كل الباقي x,lr,xx  يعتبرها Variant وبالتالي يحجز لها مكاناَ كبيراً في Memory

بجب ان يعّرف كل متفير بنوعه %ْx هي نفسها X as integer

و بذلك تكون البداية

Dim ws As Worksheet, x%, lr%, xx As Worksheet

2- لا حاجة لتنشيط الخلية المعنية بالأمر

 Cells(x, 4).Activate لان هذا يزيد من مهمة الكود دون سبب و لا داعي له فقط اكنب

 For x = 9 To lr
          '=====================
       If xx.Name <> "الرئيسية" And xx.Name <> "طباعة" Then
         xx.Range("h4").Value = xx.Range("d" & lr)
       End If
   '=====================

3-أين عملية الجمع من الرقم 9 الى الخلية ما قبل الاخيرة

[حسين مامون]

درس ممتاز استاذنا العزيز

الف الف شكر 

نستفيذ كثيرا منكم 

حفظكم الله اخي

بالنسبة لعملية الجمع لم اطلبها في طلبي بالمشاركة الاولى ولكن لابأس بها  

[سليم حاصبيا]

4 دقائق مضت, حسين مامون said:

درس ممتاز استاذنا العزيز

الف الف شكر 

نستفيذ كثيرا منكم 

حفظكم الله اخي

بالنسبة لعملية الجمع لم اطلبها في طلبي بالمشاركة الاولى ولكن لابأس بها  

حاول وضع عملبة الجمع في الكود وارفعه (الكود فقط)

مع مراعاة الملاحظات التي ارسلتها

[حسين مامون]

Sub doyoun()

         Dim ws As Worksheet, x%, lr%, xx As Worksheet, rng As Range
          Application.ScreenUpdating = False
          For Each xx In Sheets
          lr = xx.Cells(Rows.Count, "d").End(xlUp).Row
          For x = 9 To lr
          If xx.Name <> "الرئيسية" And xx.Name <> "طباعة" Then
          xx.Range("h4").ClearContents
          Set rng = xx.Range("d9:d" & lr)
         xx.Range("h3").Value = Application.Sum(rng)
         xx.Range("h3").Offset(1) = xx.Range("d" & lr)
          End If
          Next
          Next
          Application.ScreenUpdating = True
       
End Sub

 

تفضل اخي

 

[سليم حاصبيا]

منذ ساعه, حسين مامون said:

Sub doyoun()

         Dim ws As Worksheet, x%, lr%, xx As Worksheet, rng As Range
          Application.ScreenUpdating = False
          For Each xx In Sheets
          lr = xx.Cells(Rows.Count, "d").End(xlUp).Row
          For x = 9 To lr
          If xx.Name <> "الرئيسية" And xx.Name <> "طباعة" Then
          xx.Range("h4").ClearContents
          Set rng = xx.Range("d9:d" & lr)
         xx.Range("h3").Value = Application.Sum(rng)
         xx.Range("h3").Offset(1) = xx.Range("d" & lr)
          End If
          Next
          Next
          Application.ScreenUpdating = True
       
End Sub

 

تفضل اخي

 

تعديل بسيط

Option Explicit

Sub doyoun()
'استعمال With و   End With يزيد من سرعة الماكرو للبيانات الكبيرة
'ْxلا حاجة للمتغير

         Dim ws As Worksheet, lr%, xx As Worksheet, rng As Range
          Application.ScreenUpdating = False
          For Each xx In Sheets
           With xx
                lr = .Cells(Rows.Count, "d").End(xlUp).Row
                '==================================
''                       For x = 9 To lr  لا حاجة لهذا السطر
                  '==================================
                      If .Name <> "الرئيسية" And .Name <> "طباعة" Then
                          .Range("h3:h4").ClearContents
                             Set rng = .Range("d9:d" & lr)
                          .Range("h3").Value = Application.Sum(rng)
                          .Range("h3").Offset(1) = .Range("d" & lr)
                      End If
                        '==================================
'                    Next  لا حاجة لهذا السطر
                        '==================================
        End With
          Next
          Application.ScreenUpdating = True
       
End Sub

ان استعمال المتغير x من 9 الى lr هنا تجعل الكود يكرر نقسه عدة مرات في كل صفجة

[حسين مامون]

جزاك الله خيرا استاذ سليم 

تحياتي