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

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

  • أفضل إجابة
قام بنشر

اذا كان النض يحتوي على اكثر من عدد (قي أوله أو منتصفه أو آخره)

وجدت لكم الحل بواسطة هذا الكود

Option Explicit

Sub Extract_Number_From_Text()
    Dim rgx As Object
    Dim My_Number As Object
    Dim ws As Worksheet
    Dim i%, m%, k%, x%, Ro%
    
    Set rgx = CreateObject("VBScript.RegExp")
    Set ws = Worksheets("Salim")
    Ro = ws.Cells(Rows.Count, 1).End(3).Row
    m = 1: k = 3
    With ws.Cells(m, k).CurrentRegion
    .ClearContents
    .Interior.ColorIndex = xlNone
    End With
    With rgx
       .Global = True: .Pattern = "(\d+\.?\d+)"
           For i = 1 To Ro
              If .Test(ws.Cells(i, 1)) Then
                Set My_Number = .Execute(ws.Cells(i, 1))
                  For x = 0 To My_Number.Count - 1
                    ws.Cells(m, k).Offset(, x) = Val(My_Number.Item(x))
                  Next x
            End If
              m = m + 1
        Next i
  End With
  
      With ws.Cells(m, k).Resize(, 2)
        .Formula = "=SUM(C1:C" & m - 1 & ")"
        .Value = .Value
        .Interior.ColorIndex = 6
      End With
ws.Cells(m, k).Offset(, 2) = "Sum"
Set rgx = Nothing: Set ws = Nothing
Set My_Number = Nothing

End Sub

الصفحة  salim  من هذا الملف

Hasan_Mhd_With_Macro.xlsm

  • Like 2

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