اذهب الي المحتوي
أوفيسنا

استخراج اكبر قيمه


إذهب إلى أفضل إجابة Solved by محمد هشام.,

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

عشان تقدر تطبق المطلوب كان لابد من عمد كود برمجة فيه داله اسمها MaxNumber تعمل المطلوب وبشكل مختصر 
هذا كود البرمجة:

Function MaxNumber(rng As Range) As Double
    Dim cell As Range
    Dim matches As Object
    Dim largest As Double
    Dim regex As Object
    
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "\d+(\.\d+)?"
    
    largest = -1
    
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            Set matches = regex.Execute(cell.Value)
            If matches.Count > 0 Then
                Dim match As Variant
                For Each match In matches
                    If CDbl(match.Value) > largest Then
                        largest = CDbl(match.Value)
                    End If
                Next match
            End If
        End If
    Next cell
    
    MaxNumber = largest
End Function

بعد كده اختار أي عمود تحتاجه عادي جدا زي ما بتعمل أي معادلة 

وهذه المعادلة  كده بتكون :

=MaxNumber(A1:A100)


تحياتي 🙂

اكبر قيمه.xlsm

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

تحياتي للأستاذ / أمير  حل رائع . إضافة بسيطة و هو كود لاستحراج أكبر قيمة مع النص الموجود بجانب الرقم

Function LargestValueWithOriginalText(rng As Range) As String
    Dim cell As Range
    Dim matches As Object
    Dim maxNum As Double
    Dim num As Double
    Dim regex As Object
    Dim resultText As String
    
    ' Create a regular expression object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\d+\.?\d*" ' Pattern to match numbers (including decimals)
    regex.Global = True
    
    maxNum = -1 ' Initialize maxNum to a low value
    resultText = "No numeric values found." ' Default message
    
    ' Loop through each cell in the specified range
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            ' Find all matches in the cell
            Set matches = regex.Execute(cell.Value)
            ' Loop through all found matches
            For Each Match In matches
                num = CDbl(Match.Value) ' Convert match to a number
                If num > maxNum Then
                    maxNum = num ' Update maxNum if the current number is larger
                    resultText = cell.Value ' Store the text of the cell with the largest number
                End If
            Next Match
        End If
    Next cell
    
    ' If a number was found, return the original text
    If maxNum > -1 Then
        LargestValueWithOriginalText = resultText
    Else
        LargestValueWithOriginalText = resultText
    End If
End Function

 

اكبر قيمه (2).xlsm

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

  • أفضل إجابة

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

بعد إدن الإخوة الكرام اليك حلول اخرى بالمعادلات 

555.JPG.84d34415a427a89deccc27641b3f5170.JPG

 

=MAX(IFERROR(VALUE(LEFT(A1:A200, LEN(A1:A200) - IF(ISNUMBER(VALUE(RIGHT(A1:A200, 1))), 0, 1))), A1:A200))

 أو 

66666.JPG.1ed3e3bd730fb3209ed451bde671948b.JPG

 

=MAX(LET(val,A1:A200, num, IFERROR(VALUE(LEFT(val, LEN(val) - IF(ISNUMBER(VALUE(RIGHT(val, 1))), 0, 1))), val), IF(ISNUMBER(num), num, 0)))

 في حالة الرغبة باستخدام الأكواد إليك الدالة التالية 

Function GetMaxValue(rng As Range) As Double
    Dim maxValue As Double, n As Double
    Dim Cnt As String, r As String, cell As Range
    c = 0
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            Cnt = cell.Value
            If IsNumeric(Right(Cnt, 1)) Then
                n = CDbl(Cnt)
            Else
                r = Left(Cnt, Len(Cnt) - 1)
                n = CDbl(r)
            End If
               If n > c Then
                c = n
            End If
        End If
    Next cell
    GetMaxValue = c
End Function

 

=GetMaxValue(A1:A200)

 

 

اكبر قيمة V2.xlsb

تم تعديل بواسطه محمد هشام.
  • Like 1
رابط هذا التعليق
شارك

On 10/8/2024 at 5:34 AM, hegazee said:

تحياتي للأستاذ / أمير  حل رائع . إضافة بسيطة و هو كود لاستحراج أكبر قيمة مع النص الموجود بجانب الرقم

Function LargestValueWithOriginalText(rng As Range) As String
    Dim cell As Range
    Dim matches As Object
    Dim maxNum As Double
    Dim num As Double
    Dim regex As Object
    Dim resultText As String
    
    ' Create a regular expression object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\d+\.?\d*" ' Pattern to match numbers (including decimals)
    regex.Global = True
    
    maxNum = -1 ' Initialize maxNum to a low value
    resultText = "No numeric values found." ' Default message
    
    ' Loop through each cell in the specified range
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            ' Find all matches in the cell
            Set matches = regex.Execute(cell.Value)
            ' Loop through all found matches
            For Each Match In matches
                num = CDbl(Match.Value) ' Convert match to a number
                If num > maxNum Then
                    maxNum = num ' Update maxNum if the current number is larger
                    resultText = cell.Value ' Store the text of the cell with the largest number
                End If
            Next Match
        End If
    Next cell
    
    ' If a number was found, return the original text
    If maxNum > -1 Then
        LargestValueWithOriginalText = resultText
    Else
        LargestValueWithOriginalText = resultText
    End If
End Function

 

اكبر قيمه (2).xlsm 18.09 kB · 18 downloads

هل من الممكن التعديل على المعادلة للاستخراج اكبر تاريخ بدل من القيمة ؟؟؟

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

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

Important Information