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

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

قام بنشر

السلام عليكم 

برجاء المساعده في معدله استخراج اكبر قيمه مع علم وجود حروف بجانب الارقام 

 

وشكرا 

image.png

قام بنشر

السلام عليكم 

اولا شكرا جزيل لاهتمام حضرتك بس لو تم كتبه رقم اكبر بدون رومز لا يتم حسابه 

برجاء المساعده في حلها 

قام بنشر (معدل)

طيب تمام  بجرب طريقه اخرى

 

 

تم تعديل بواسطه AmirMohamed
قام بنشر

عشان تقدر تطبق المطلوب كان لابد من عمد كود برمجة فيه داله اسمها 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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information