[حل شده] محاسبه مجموع بیشترین مقدار اعداد مثبت متوالی بدون در نظر گرفتن تعداد

[Soubasa]

سلام
با توجه به سوالی که در لینک زیر ارسال شد:

https://forum.exceliran.com/showthread.php/19144-%D9%85%D8%AD%D8%A7%D8%B3%D8%A8%D9%87-%D8%A8%DB%8C%D8%B4%D8%AA%D8%B1%DB%8C%D9%86-%D9%85%D9%82%D8%AF%D8%A7%D8%B1-%D9%88-%D8%AA%D8%B9%D8%AF%D8%A7%D8%AF-%D8%A7%D8%B9%D8%AF%D8%A7%D8%AF-%D9%85%D8%AB%D8%A8%D8%AA-%D9%85%D8%AA%D9%88%D8%A7%D9%84%DB%8C

فرمولی نیاز دارم که مجموع بیشترین مقدار اعداد مثبت متوالی را بدون در نظر گرفتن تعداد حساب نماید و در فرمولی دیگر تعداد اعداد این مقدار مجموع را حساب نماید
در فایل ارسال شده جزئیات مشخص است
پیشاپیش از راهنمایی شما سپاسگزارم

Consecutive Maximal.xlsx

[Soubasa]

Copy-of-Consecutive-Maximal-2.xlsx

در فایل بالا از طریق power query نوشته شده است اما استفاده برای من فوق العاده سخت است

آیا برای سلول B و C مانند فایل زیر امکان فرمول نویسی وجود دارد؟

Consecutive Maximal (1).xlsx

[iranweld]

با سلام

جمع اعداد مثبت و تعداد متوالی را در فایل بررسی کنید.

[Soubasa]

سلام ممنون از شما
فرمول VBA به درستی کار میکند اما 2 مشکل دارم
1: فرمول برای اعداد منفی را چکار کنم؟
2: این worksheet یا فرمول VBA را چگونه به فایل اصلی خودم منتقل کنم؟
بی نهایت تشکر از لطفی که دارید

[iranweld]

سلام ممنون از شما
فرمول VBA به درستی کار میکند اما 2 مشکل دارم
1: فرمول برای اعداد منفی را چکار کنم؟
2: این worksheet یا فرمول VBA را چگونه به فایل اصلی خودم منتقل کنم؟
بی نهایت تشکر از لطفی که دارید

از مسیر نمایش داده شده در تصویر دو فانکشن موجود را Export نموده و در جایی ذخیره کنید و سپس از همین مسیر برای فایل اصلی خود import نمایید

[generalsamad]

با سلام
با اجازه استاد عزیز آقای حسن پور
این کد رو هم برای اعداد منفی تست کنید از همون کد بالا استفاده شده فقط با کمی تغییرات

Function mmmin(x1 As Range)
Dim list1 As New Collection
Dim list2 As New Collection
xx = 0
kk = 0
For i = 1 To x1.Count + 3
    If IsNumeric(x1.Item(i)) And x1.Item(i) < 0 Then
        xx = xx + x1.Item(i)
        kk = kk + 1
    ElseIf xx < 0 And x1.Item(i) > 0 Or i = x1.Count + 3 Then
        list1.Add xx
        list2.Add kk
        xx = 0
        kk = 0
    End If
Next
Min = 0
For k = 1 To list1.Count
    If list1.Item(k) < Min Then
        Min = list1.Item(k)
        zz = list2.Item(k)
    End If
Next
mmmin = Min
End Function
Function mmcmin(x1 As Range)
Dim list1 As New Collection
Dim list2 As New Collection
xx = 0
kk = 0
For i = 1 To x1.Count + 3
    If IsNumeric(x1.Item(i)) And x1.Item(i) < 0 Then
        xx = xx + x1.Item(i)
        kk = kk + 1
    ElseIf xx < 0 And x1.Item(i) > 0 Or i = x1.Count + 3 Then
        list1.Add xx
        list2.Add kk
        xx = 0
        kk = 0
    End If
Next
Min = 0
For k = 1 To list1.Count
    If list1.Item(k) < Min Then
        Min = list1.Item(k)
        zz = list2.Item(k)
    End If
Next
mmcmin = zz
End Function 

فایل ضمیمه گردید