طلب ع السريع ... مساعدة في اجمالي اعمدة

[جمعة العوامي]

الملف المرفق يوضح ذلك .. يرجى ممن لديه الحل .. ان يزودني به واكون له من الشاكرين 

وبارك الله فيكم 

رغبة مجموع.xlsm

[بن علية حاجي]

السلام عليكم

الملف المرفق فيه حل... راجعه إن كان هو المطلوب...

بن علية حاجي

رغبة مجموع.xlsm

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

جرب هذا الملف

salim_sum.xlsm

[جمعة العوامي]

الأستاذان الكريمان .... سليم حاصبيا و بن علية حاجي

بارك الله فيكم ولكم .. و لكن برجاء وبعد اذنكم ، كيف يتم الحل عن طريق الماكرو وليس الدوال .. أقصد عن طريق المصفوفات ولم اتعلم تلك الطريقة بعد .. يرجى مساعدتكم ...

ولقد عملت دالة sumif  ولكنها لم تنجح معي .. طريقتان الاولى عن طريق الكمبوبوكس واختار المجموع كل واحدة على حدة .. والثانية يمسح المدى b5:B19 ويعطى المجموع دفعة واحدة وامام كل بيان مجموعه .. احتاج لذلك كثيرا في عملي ...

 

Sub subtot1()

Dim ws As Worksheet

Set ws = Sheets("51")

 

For r = 5 To 19

ws.Range("b" & r) = Application.WorksheetFunction.SumIf(ws.Range("J3:X100"), ws.Range("a" & r), ws.Range("j4:x100"))

Next

End Sub

فكيف يتم ذلك ؟ الله يرحم والديكم .. شاكرا تعبكم معنا .. 

تم تعديل مارس 1, 2019 بواسطه جمعة العوامي

[جمعة العوامي]

وجربت هذا الكود ايضا ولم ينجح معي ...

 

Dim ws As Worksheet

Set ws = Sheets("01")

Dim xadi, c, cc As Integer

xadi = ws.Cells(ws.Rows.Count, "d").End(xlUp).Row

For cc = 15 To 29

Range("f" & cc).Formula = Sum(Application.WorksheetFunction.Index(ws.Range("J4:X" & xadi), , Application.WorksheetFunction.Match(Range("D" & cc), ws.Range("J3:X3"), 0)))

Next

 

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

جرب هذا الكود

النتائج في الورقة  salim

Option Explicit
Private Sub Salim_Com_Click()

With Sheets("salim")
  Dim c%
   Combo_Salim.Clear
      c = 5
     Do Until Cells(c, 1) = vbNullString
       Combo_Salim.AddItem .Cells(c, 1)
       c = c + 1
     Loop
 End With
End Sub
'==============================
Sub Add_Sum()
With Sheets("salim")
'''''''''''''''''''''''''
     With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
     End With
  .Range("b5", Range("b4").End(4)).ClearContents
     Dim s#, k%, r%, i%: i = 5
    
     Do Until .Cells(i, 1) = vbNullString
           k = Application.Match(.Cells(i, 1), Rows(3), 0)
        For r = 4 To 50
           If IsNumeric(.Cells(r, k)) Then _
           s = s + .Cells(r, k)
        Next
         .Cells(i, 1).Offset(, 1) = s
         s = 0
         i = i + 1
     Loop
   '''''''''''''''''''''''''
 End With
 With Application
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 End With
End Sub

الملف مرفق

 

 

salim_sum_new.xlsm

[جمعة العوامي]

58 دقائق مضت, سليم حاصبيا said:

جرب هذا الكود

النتائج في الورقة  salim

Option Explicit
Private Sub Salim_Com_Click()

With Sheets("salim")
  Dim c%
   Combo_Salim.Clear
      c = 5
     Do Until Cells(c, 1) = vbNullString
       Combo_Salim.AddItem .Cells(c, 1)
       c = c + 1
     Loop
 End With
End Sub
'==============================
Sub Add_Sum()
With Sheets("salim")
'''''''''''''''''''''''''
     With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
     End With
  .Range("b5", Range("b4").End(4)).ClearContents
     Dim s#, k%, r%, i%: i = 5
    
     Do Until .Cells(i, 1) = vbNullString
           k = Application.Match(.Cells(i, 1), Rows(3), 0)
        For r = 4 To 50
           If IsNumeric(.Cells(r, k)) Then _
           s = s + .Cells(r, k)
        Next
         .Cells(i, 1).Offset(, 1) = s
         s = 0
         i = i + 1
     Loop
   '''''''''''''''''''''''''
 End With
 With Application
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 End With
End Sub

الملف مرفق

 

 

salim_sum_new.xlsm

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

 

وأخيرا المجاميع.xlsm

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

استبدل اسم الصفحة"حاسب " الى "Haseb"  ونفذ هذا الكود

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

Option Explicit

Sub sum_from_Other_sheet()
Dim source_sh As Worksheet: Set source_sh = Sheets("salim")
Dim target_sh As Worksheet: Set target_sh = Sheets("Haseb")
 Dim i: i = 5
 Dim k%, xx%, n_rows%: n_rows = 50
 Dim s#
 
  With source_sh
    Do Until .Cells(i, 1) = vbNullString
   k = Application.Match(.Cells(i, 1), target_sh.Rows(3), 0)
   For xx = 4 To n_rows
     If IsNumeric(target_sh.Cells(xx, k)) Then
     s = s + target_sh.Cells(xx, k)
    End If
    Next
    .Cells(i, 1).Offset(, 1) = s
     s = 0: i = i + 1
    Loop
  End With
  
End Sub

 

[جمعة العوامي]

الاستاذ : سليم حاصبيا 

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

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

وهذه صورة عن نتيجة عملي بالكود الذي بعثته لي ... 

ولساني عاجز عن الشكر سامحنا ..

 

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

أرجو رفع الكود بعد التعديل لعل أحد من الأعضاء يستفيد منه

 

[جمعة العوامي]

sub khasem
Dim wwsw As Worksheet  'source_sh As Worksheet:
Set wwsw = Sheets("kholasa") 'source_sh = Sheets("salim")

Dim ws As Worksheet 'target_sh As Worksheet:
Set ws = Sheets("haseb") 'target_sh = Sheets("Haseb")
 Dim i: i = 15
 Dim k%, xx%, n_rows%: 'n_rows = 50
 Dim s#, rr%
 n_rows = ws.Cells(ws.Rows.Count, "d").End(xlUp).Row
  With wwsw
    Do Until .Cells(i, 4) = vbNullString
   k = Application.Match(.Cells(i, 4), ws.Rows(3), 0)
   For xx = 4 To n_rows
     If IsNumeric(ws.Cells(xx, k)) Then
      If ws.Cells(xx, k) > 0 Then rr = rr + 1
       s = s + ws.Cells(xx, k)
       
    End If
    Next
    .Cells(i, 4).Offset(, 2) = s
    .Cells(i, 4).Offset(, 1) = rr
     s = 0: rr = 0: i = i + 1
    Loop
  End With
end sub

 

تم تعديل مارس 2, 2019 بواسطه جمعة العوامي

[جمعة العوامي]

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

كود ممتاز و أرجو ان تتقبل مني هذه الملاحظلات:

1 - من الخطأ ان تحدد المتغير n_rows  كاخر صف في العامود D من الصفحة ws لانه ممكن ان يكون  عامود اخر غير D أطول باليبانات

      (أقصد اخر خلية غير فارغة فيه موجودة في صف اكبر من n_rows)

      لذلك بجب ان تأخذ اكبر عدد ممكن (أنا اخذت 50 و ممكن أكثر )  "" اذا اردت يمكن تحديد العامود الذي يملك اكبر اخر صف

      (بواسطة سطرين بنفس   الكود)  و تعمل   على  اساسه""

2- من الضروري جداً وضع عبارة Option Explicit  في بداية أي كود تقوم بكتابته ،لأن هذه العبارة توقف الكود عن النتفيذ

      اذا كان هناك اي خطأ في اي متغير 

         مثلاً (تم الاعلان عن متغير  My _cell ب Dim وفي احد الاماكن من الكود تم كتابة  My_ cel ) Only l) 

     فإن الكود يتوقف و تظهر لك رسالة مع تحدديد الحطأ باللون الازرق)

3- عدا عن ذلك بوجود Option Explicit يمكن الاسراع بكتابة الكود لان مجرد كتابة اول حرف او حرفين من اسم المتغير و الضفط على

      مفتاح Ctrl+  المسافة تظهر لك لائحة بالمتغيرات لتختار ماذا تريد

4- أخيراً بوجود Option Explicit فإن الكود يرفض التعامل مع اي متغير لم يتم الاعلان عنه بواسطة  Dim

 

للمزيد شاهد هذا الفيديو

https://www.youtube.com/watch?v=nKgF9tA-8gc

 

[جمعة العوامي]

 

الأستاذ  .... سليم حاصبيا

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

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

ووفقك الله لما يحبه ويرضاه ...

 

طباعة كشف.xlsm

[جمعة العوامي]

للرفع ... 

[جمعة العوامي]

الحل هو قبل نهاية الصفحة بسطر insertRows  لعدد 10 اسطر ..

السطر الأول قي الخلية اكتب يتبع .. ورقم الصفحة التالية .. 

وفي السطر الثالث بداية الصفحة التالية اكتب صفحة ورقم الصفحة الحالية 

وفي السطر الحامس اكتب عنوان الكشف 

وفي السطر التاسع اعمل عنوان الكشف ..

وفي السطر العاشر اكمل  بقية الكشف لغاية نهاية الصفحة .. وهكذا دواليك لبقية الصفحات ..

واشكر مساعدتكم ومروركم ... 

 

[جمعة العوامي]

ممكن عندك الحل استاذ بن علية حاجي

بارك الله فيك ....