اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ملخص بيانات في شيت اخر


إذهب إلى أفضل إجابة Solved by lionheart,

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

في الملف المرفق يوجد في شيت "الاعمال" مجموعة اعمال مثل الحفر و الخرسانة العادية والخرسانة المسلحة 

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

المبنى1 بند الحفر والردم = 1000      وفي المبنى2 بند الحفر والردم = 1500 

الملف المرفق يوضح المطلوب .. انتبه من فضلك , طالما انك تريد طلبك بالأكواد .فكان لزاما عليك رفع الملف بإمتداد Xlsm ... فقد تـــم اعادة رفع الملف بهذا الإمتداد

ملحص.xlsm

رابط هذا التعليق
شارك

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

أخي الكريم هل هذا ما تريد الوصول إليه 

فإن لم يكن يرجى التوضيح اكثر

تم استخدام الدالة Sumif للوصول إلى النتائج لكن بعد إلغاء دمج الخلايا في ملف البيانات

كما يلي:

ملحص.xlsx

  • Like 2
رابط هذا التعليق
شارك

شكرا لمجهودك بس اول حاجه مش هينفع اعمل الغاء دمج الخلايا لان عايز اطبقها اوتوماتك على اكتر من 500 بند وفي كذا ملف مختلف انا محتاج كود ينفذ المطلوب 
 

رابط هذا التعليق
شارك

لا اعتقد  ممكن  مع  خلايا  مدمجة  وان  امكن  سيحدث  لك  مشاكل  في  المستقبل  وقد  يتم تدمير  ملف  اكسيل  وتفقد  جميع  بياناتك 

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

  • Like 3
رابط هذا التعليق
شارك

  • أفضل إجابة
Sub Test()
    Dim ws As Worksheet, sh As Worksheet, rRange As Range, rCell As Range, rng As Range, t As Double, iRow As Long, r As Long, c As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets(2)     'Tasks
        Set sh = ThisWorkbook.Worksheets(1)     'Summary
        iRow = 4: r = iRow
        With sh.Rows(iRow + 1 & ":" & Rows.Count)
            .ClearContents: .Borders.Value = 0
        End With
        Set rRange = ws.Range("B5:B" & ws.Cells(Rows.Count, "B").End(xlUp).Row)
        Set rCell = rRange.Cells(1, 1)
        Do
            If rCell.Value = Chr(199) & Chr(225) & Chr(199) & Chr(204) & Chr(227) & Chr(199) & Chr(225) & Chr(237) Or rCell.Value = Empty Then GoTo NXT
            r = r + 1: t = 0
            sh.Cells(r, 1).Value = r - iRow
            sh.Cells(r, 2).Value = rCell.Value
            For c = 3 To 16
                Set rng = rCell.Offset(, c - 2).Resize(rCell.MergeArea.Rows.Count)
                t = Application.WorksheetFunction.Sum(rng)
                If t = 0 Then sh.Cells(r, c).Value = Empty Else sh.Cells(r, c).Value = t
            Next c
NXT:
            Set rCell = rCell.Offset(1, 0)
            Set rng = Nothing
        Loop Until (rCell.Row > (rRange.Row + rRange.Rows.Count - 1))
        With sh.Rows(iRow + 1 & ":" & r)
            .Borders.Value = 1
        End With
    Application.ScreenUpdating = True
End Sub

 

  • Like 4
  • Thanks 2
رابط هذا التعليق
شارك

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

ما شاء الله بارك الله أخي الحبيب @lionheart حل رائع ، مذهل ، أحسنتم بارك الله بكم
تقبل تحياتي العطرة لشخصكم الكريم.

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

  • Like 1
رابط هذا التعليق
شارك

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

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

Important Information