أزهر قام بنشر بالامس في 07:54 مشاركة قام بنشر بالامس في 07:54 (معدل) السلام عليكم لدي الملف المرفق مثالاً لما هو مطلوب تحقيقه المعطيات: جدول (بيانات 1): يحتوي على بيانات النوع والجهة والرقم المطلوب: هو فرز البيانات الموجودة بالجدول (بيانات 1) وذلك بحسب العنوان الموجود في الجدول (بيانات 2) وتكون النتيجة كما هو مذكور في جدول (بيانات 2) والرقم يتم تجميع الأرقام الشرط: عدم تكرار نفس النوع والجهة معاً، وإذا تكررا يقوم بجمع أرقامهما كما في المثال المرفق Book1.xlsx تم تعديل منذ 22 ساعات بواسطه أزهر تعديل الملف رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر منذ 20 ساعات أفضل إجابة مشاركة قام بنشر منذ 20 ساعات 4 ساعات مضت, أزهر said: وذلك بحسب العنوان الموجود في الجدول (بيانات 2) هل تقصد ان جدول البيانات 2/ النوع و الجهة موجودة مسبقا على الجدول فقط يتم تجميع الأرقام و الشرط: عدم تكرار نفس النوع والجهة معاً ادا كان هدا ما تقصده يكفي وضع المعادلة التالية في عمود H =IF(AND(G4<>"", F4<>""), IFERROR(SUMIFS(D4:D100, C4:C100, G4, B4:B100, F4), ""), "") أما إدا كنت ترغب باستخراج البيانات بالشكل الواضح في الصورة بدون وضع بيانات مسبقا استخدم الكود التالي في حدث ورقة 1 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Set rng = Intersect(Target, Me.Range("B4:D" & Me.Rows.Count)) If Not rng Is Nothing Then TotalNonTri End If End Sub Sub TotalNonTri() Dim a() As Variant, i&, lig&, key As Variant, tmp As Variant Dim WS As Worksheet, d As Object, tbl As Variant, n As String Set d = CreateObject("Scripting.Dictionary") Set WS = Sheets("Sheet1") tbl = Range("B4:D" & Cells(Rows.Count, "B").End(xlUp).Row).Value Application.ScreenUpdating = False WS.Range("F4:H" & WS.Rows.Count).ClearContents For i = LBound(tbl, 1) To UBound(tbl, 1) If Not IsEmpty(tbl(i, 1)) And Not IsEmpty(tbl(i, 2)) Then n = tbl(i, 1) & "|" & tbl(i, 2) If d.Exists(n) Then d(n) = d(n) + tbl(i, 3) Else d(n) = tbl(i, 3) End If End If Next i ReDim a(1 To d.Count, 1 To 3) lig = 1 For Each key In d.Keys tmp = Split(key, "|") a(lig, 1) = tmp(0): a(lig, 2) = tmp(1): a(lig, 3) = d(key) lig = lig + 1 Next key With Range("F4").Resize(d.Count, UBound(a, 2)) .Value = a End With Application.ScreenUpdating = True End Sub Book1.xlsb 1 رابط هذا التعليق شارك More sharing options...
أزهر قام بنشر منذ 3 ساعات الكاتب مشاركة قام بنشر منذ 3 ساعات جزاك الله كل خير ما كنت أقصده هو ما تفضلت به (باستخراج البيانات بالشكل الواضح في الصورة بدون وضع بيانات مسبقا) والكود يعمل بشكل صحيح رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان