اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر (معدل)

السلام عليكم

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

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

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

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

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

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

تم تعديل بواسطه حسين مامون
قام بنشر

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

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

 

  • Like 1
قام بنشر (معدل)

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

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

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

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

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

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

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

 

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

تم تعديل بواسطه حسين مامون
قام بنشر
استاذ سليم ... بعد ما فهمت الكود الذ ارسلته في المشاركة السابقة وجدت ان سبب المشكلة في هذا الجزء
.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 الى الخلية ما قبل الاخيرة

  • Like 1
قام بنشر

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

الف الف شكر 

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

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

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

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

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

الف الف شكر 

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

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

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

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

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

  • Like 1
قام بنشر
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 هنا تجعل الكود يكرر نقسه عدة مرات في كل صفجة

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information