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

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

  • تمت الإجابة
قام بنشر

للمرة الألف  (اختصار البيانات للتحقق من عمل الكود)

الكود الي يعمل على صف واحد يمكنه العمل على الالوف منها

هذا  الماكرو

Option Explicit
Sub Merged_Sum()
Dim ro, i%
ro = Cells(Rows.Count, 2).End(3).Row
Dim n%

With Range("D6:D" & ro)
.ClearContents
.Interior.ColorIndex = xlNone
End With

For i = 6 To ro
    If Val(Cells(i, 3)) <> 0 Then
      n = Cells(i, 2).MergeArea.Rows.Count
      With Cells(i, 4)
       .Value = Application.Sum(Cells(i, 3).Resize(n))
       .Interior.ColorIndex = 6
      End With
      i = i + n - 1
    End If
Next
End Sub

الملف مرفق

Naser.xlsm

  • Like 1
  • Thanks 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