مساعدة في برنامج متعدد المدخلات

[K.Sabban]

السلام عليكم

قمت بعمل برنامج صغير يقوم باجراء معادلات على مجموعة خلايا

 يعمل البرنامج بشكل مناسب فقط عندما تكون المدخلات على شكل

RANGE 

 

لكن اذا كانت المدخلات متفرقة او اكثر من

RANGE

تظهر رسالة خطأ

 

حاولت استخدام

paramarray

لكن لم تنجح المحاولة.

 

المطلوب ان تكون المدخلات متعددة مثل دالة الجمع في الاكسل

المحاولات في الملف المرفق 

 

شكرا جزيلا

SumdB.xlsm

تم تعديل سبتمبر 4 بواسطه K.Sabban

[محمد هشام.]

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

يمكنك اخي دمج الدلة  للتعامل بشكل صحيح مع مدخلات متعددة تتضمن أكثر من نطاق على الشكل التالي 

 

Function dbsum(ParamArray Knowndb()) As Variant
    Dim firstsum As Double
    Dim rng As Range
    Dim i As Integer

    firstsum = 0
        For i = LBound(Knowndb) To UBound(Knowndb)
        If TypeName(Knowndb(i)) = "Range" Then
            For Each rng In Knowndb(i)
                firstsum = firstsum + WorksheetFunction.Power(10, rng.Value / 10)
            Next rng
        Else
            firstsum = firstsum + WorksheetFunction.Power(10, Knowndb(i) / 10)
        End If
    Next i
    dbsum = 10 * WorksheetFunction.Log10(firstsum)
End Function

 

=dbsum(P11:P12,N9:N10)

=dbsum(K11:K13,I9:I10)

=dbsum(F9:F12)

 

SumdB.xlsm

 

كما يمكنك تعديل الدالة  بحيث تكون أكثر كفاءة وقادرة على التعامل مع مجموعة متنوعة من المدخلات بما في ذلك النطاقات _  القيم الفردية _ والمصفوفات

Function dbsum(ParamArray Knowndb()) As Variant
    Dim cnt As Double, rng As Range
    Dim i As Integer, j As Integer
    
    cnt = 0
    
    On Error GoTo ErrorHandler
        For i = LBound(Knowndb) To UBound(Knowndb)
        Select Case TypeName(Knowndb(i))
            Case "Range"
                For Each rng In Knowndb(i)
                    If IsNumeric(rng.Value) Then
                        cnt = cnt + WorksheetFunction.Power(10, rng.Value / 10)
                    Else
                        Err.Raise vbObjectError + 1, , "قيمة غير رقمية في النطاق"
                    End If
                Next rng
            Case "Double", "Integer", "Single", "Currency", "Long"
                cnt = cnt + WorksheetFunction.Power(10, Knowndb(i) / 10)
            Case "Variant()"
                For j = LBound(Knowndb(i)) To UBound(Knowndb(i))
                    If IsNumeric(Knowndb(i)(j)) Then
                        cnt = cnt + WorksheetFunction.Power(10, Knowndb(i)(j) / 10)
                    Else
                        Err.Raise vbObjectError + 2, , "قيمة غير رقمية في المصفوفة"
                    End If
                Next j
            Case Else
        End Select
    Next i
    dbsum = 10 * WorksheetFunction.Log10(cnt)
    Exit Function
ErrorHandler:
    dbsum = CVErr(xlErrValue)
    MsgBox "خطأ: " & Err.Description, vbCritical, "خطأ في الدالة dbsum"
End Function

 

SumdB.xlsm

تم تعديل سبتمبر 4 بواسطه محمد هشام.

[K.Sabban]

بارك الله فيك اخي محمد

كما أريد و زيادة

 

أحسن الله إليك