طلب معادله

[حسين النجدى]

السلام عليكم ورحمة الله وبركاته انا لم استطع فعله  اريد تحويل هذا الكلام الى معادله رجاء وتكرم *** (اذا كانت قيمة c8 تساوى 1/1 وقيمة d8 تساوى ذكر قم بنسخ a8 الى b7 في ورقة أخرى مع الاخذ فى الاعتبار النزول بالمعادله وعدم ترك صفوف فارغة بين الصفوف )***

[محمد هشام.]

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

 إذا كنت تستخدم اصدارات حديثة من اللأوفيس يمكنك استخدام دالة FILTER  للحصول على النتائج  إذا لم تكن لديك هذه الإصدارات يمكنك استخدام دالة IF مع INDEX و SMALL

 سنقوم مثلا باستخراج البيانات  من Sheet1 ووضعها في Sheet2

في أول خلية لعمود النتائج على Sheet2

=FILTER(Sheet1!A8:A100, (Sheet1!C8:C100="1/1")*(Sheet1!D8:D100="ذكر"))

او 

=IFERROR(INDEX(Sheet1!A$8:A$100, SMALL(IF((Sheet1!C$8:C$100="1/1")*(Sheet1!D$8:D$100="ذكر"), ROW(Sheet1!A$8:A$100)-ROW(Sheet1!A$8)+1), ROW(1:1)), 1), "")

مع سحب المعادلة للأسفل 

بهذه الطريقة يمكنك استخراج القيم المطلوبة دون ترك صفوف فارغة بين النتائج 

 

 

 

المعادلة.xlsx

[حسين النجدى]

يعجز عن الشكر لسانى 

ولكن انا مش عارف اشغلها عندى

 

[محمد هشام.]

إذا كنت تستخدم إصدار قديم بعد وضع المعادلة اضغط على Ctrl + Shift + Enter لتفعيلها كصيغة مصفوفة

 

[elmansyeswa]

جزاك الله خيراً وجعلة الله بميزان حسناتك باذن الله

 

[محمد هشام.]

يمكنك تنفيد نفس الأمر بواسطة الأكواد 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Variant, a() As Variant, Irow As Long
    Dim i As Long, lastRow As Long, j As Long
    
    Dim WS As Worksheet: Set WS = Sheets("Sheet1")
    Dim dest As Worksheet: Set dest = Sheets("Sheet2")
    
    If Not Intersect(Target, Me.Range("A8:A1000", "C8:D1000")) Is Nothing Then
        Application.EnableEvents = False
        Irow = dest.Cells(dest.Rows.Count, "B").End(xlUp).Row
        If Irow >= 2 Then
            dest.Range("B2:B" & Irow).ClearContents
        End If
        
        lastRow = WS.Cells(WS.Rows.Count, "C").End(xlUp).Row
        If lastRow < 8 Then Exit Sub
        
        Rng = WS.Range("A8:D" & lastRow).Value
        ReDim a(1 To UBound(Rng), 1 To 1)
        j = 1
        For i = 1 To UBound(Rng, 1)
            If Rng(i, 3) = "1/1" And Rng(i, 4) = "ذكر" Then
                a(j, 1) = Rng(i, 1)
                j = j + 1
            End If
        Next i
        
        If j > 1 Then
            dest.Range("B2").Resize(j - 1, 1).Value = a
        End If
    End If
    Application.EnableEvents = True
End Sub

 

vba المعادلة.xlsb