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

معادلة فصل النصف عن الارقام بدءا من حرف معين


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

طلب احد الزملاء طريقة فصل القيم عن الحروف فى ملف اكسيل قام بنسخه من الانترنت ، من هذا الموقع

http://www.priceoftravel.com/595/public-transportation-prices-in-80-worldwide-cities/#

بالمناسبة الملف عن مقارنة لاسعار المواصلات فى عدة دول ، و لا اعلم مدى دقة بياناته

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

مرفق الملف و به المعادلة ، ربما يحتاجه البعض

الفكرة فى البجث عن مكان حرف ال $  باستخدام دالة  find و تجزيء النص بالطريقة العادية باستخدام دالتي left , right 

 

 

Split PT Prices around the world.rar

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

مشكور استاذنا الكريم ا محمد طاهر

ولاثراء الموضوع بالكود والغاء علامة  $ وتحويل القيم الى رقمية لاجراء العمليات الحسابية على المخرجات بكل سهولة

Sub splitText()
    Dim splitVals As Variant
    Dim totalVals As Long
    For Each xx In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
        splitVals = Split(xx.Value, "$")
        totalVals = UBound(splitVals)
        Range(Cells(xx.Row, xx.Column + 1), Cells(xx.Row, xx.Column + 1 + totalVals)).Value = splitVals
    Next
    FIND
    ConvertTextNumberToNumber
End Sub
Sub ConvertTextNumberToNumber()
    On Error Resume Next
    For Each Y In Sheet1.UsedRange.SpecialCells(xlCellTypeConstants)
        If IsNumeric(Y) Then Y.Value = Val(Y.Value)
    Next
End Sub
Sub FIND()
  Range("D:D").Replace What:="–", Replacement:="", LookAt:=xlPart
End Sub

تقبل تحياتي

Split PT Prices around the world.rar

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

وهذه محاولة أخرى

Sub Test()
    Dim arr, X, I As Long
    
    arr = Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 4).Value
    On Error Resume Next
    For I = LBound(arr, 1) To UBound(arr, 1)
        X = Split(arr(I, 1), "$")
        arr(I, 2) = X(0)
        arr(I, 3) = Replace(X(1), "–", "")
        arr(I, 4) = X(2)
    Next I
    Range("B2").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

 

 

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

أستاذ محمد

أولا : نشكرك على الموضوع  القيم

ثانيا :  أتمنى أن تطل علينا كل فترة  كده بموضوع  جديد  تحياتى

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

 

تحياتي للأخوة الاعزاء

 

Sub Test_1()
'
For x = 2 To Range("B" & Rows.Count).End(3)(1).Row
    vStrings_1 = Split(Cells(x, 2), "$", -1, vbBinaryCompare)
    vStrings_2 = Split(Cells(x, 2), ")", -1, vbBinaryCompare)
    Cells(x, 6) = Trim(vStrings_1(0))
    Cells(x, 7) = Trim(vStrings_2(1))
Next
'
End Sub

 

Split PT Prices around the world_3.rar

 

 

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

بارك الله فيك أخي أبو تامر

كود جميل .. بالنسبة للنتائج لا تظهر منضطبة في بعض الأحيان في خلايا معينة وهي التي تكون منفردة (حيث تختفي علامة الدولار)

مثال الصف رقم 3 حيث القيمة 0.17 بينما لم يظهر معها علامة الدولار

 

إليكم حل آخر بدالة معرفة تقوم بجلب نص محدد من داخل الخلية

Function GetElement(Str As String, Delim As String, Ordinal As Long) As Variant
    Dim strTxt() As String
    
    If Len(Str) = 0 Then
        GetElement = CVErr(xlErrNA)
        Exit Function
    End If

    If Len(Delim) > 1 Then
        GetElement = CVErr(xlErrNA)
        Exit Function
    End If

    If InStr(1, Str, Delim) = 0 Then
        GetElement = CVErr(xlErrNA)
        Exit Function
    End If

    If Ordinal <= 0 Then
        GetElement = CVErr(xlErrNA)
        Exit Function
    End If

    If Ordinal > Len(Str) - Len(Replace(Str, Delim, vbNullString)) + 1 Then
        GetElement = CVErr(xlErrNA)
        Exit Function
    End If
    
    strTxt = Split(Str, Delim)
    GetElement = Application.WorksheetFunction.Trim(strTxt(Ordinal - 1))
End Function

استخدام الدالة : استخدم المعادلتين التاليتين :

=GetElement(B2,")",1)&")"

والثانية

=GetElement(B2,")",2)

أما فيما يخص الملف المرفق فأنا لا أرفق ملفات حتى يتعود الأعضاء تطبيق الحلول بأنفسهم .. وذلك لنرتقي ونتعلم

تقبلوا تحياتي

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

 

شكرا لك اخي ياسر خليل أبو البراء

انظر الي الصورة واخبرني اين الصف الثالث المنفرد الغير منضبط

فقد يكون جهازك هو الغير منضبط

 

1.jpg

 

 

 

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

لقد قمت بتغيير التنسيق لديك  ليكون بالدولار .. أي لابد للكود خاصتك من تغيير تنسيق الخلية ..جرب الكود على أول ملف بالموضوع !!0001.png

ولعلمك جهازي منضبط جداً

 

ويمكن للأخوة الأعضاء تجربة الكود وإعطاء آرائهم ..

حكمة اليوم : من تواضع لله رفعه

تقبل تحياتي

 

 

 

 

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

 

اخي ياسر خليل أبو البراء

فعلا :

من تواضع لله رفعه

ولكني لا اتعالي  علي احد

ولست افضل من عضو بالمنتدي

فجميعنا سواسية

 

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

السلام عليكم

ما شاء الله ، ابداعات متنوعة و اثراءات  مميزة  للموضوع

أسأل الله ان يديم علينا جميعا التواضع و حب الخير ، و أن يجعلنا من المتحابين فيه ، و الا ينزغ الشيطان بيننا

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

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