المساعده فى ايجاد داله لحذف +++ الذائده كما موضح بالاكسيل الموجوده فى مواد الطلاب

[MIDO189]

RS_ST_196(8).xls

[محمد هشام.]

 لم استوعب طلبك جيدا لاكن جرب شيء كهدا

=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(B7, " + ", " "), " +", ""), "+ ", ""))
او

=TRIM(SUBSTITUTE(TEXTJOIN(" + ", TRUE, FILTER(TEXTSPLIT(B7, " + "), TEXTSPLIT(B7, " + ") <> "")), " + +", " +"))

 

[MIDO189]

منذ ساعه, محمد هشام. said:

=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(B7, " + ", " "), " +", ""), "+ ", ""))

 

ممكن اضافة الكود للملف

 

[محمد هشام.]

RS_ST_196.xls

[MIDO189]

ياصديقى شكرا لك على تعبك ولكن لم تفهم قصدى

المواد مكتوبه ولكن يوجد + بعد المواد زياده يعنى مثل عاوز

عربى + حساب+ جغرافيا   زى ده

مش كده

عربى +حساب+ جغرافيا + + +

الزائد الى بعد الجغرافيا بقى عاوز اشيلهم

 

[hegazee]

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

RS_ST_196(8).xls

[محمد هشام.]

هل تقصد أنك تريد إزالة علامات [+] الزائدة في نفس مكان  للبيانات الأصلي؟  ربما تحتاج إلى استخدام الأكواد لتنفيذ طلبك 

[محمد هشام.]

 

15 ساعات مضت, MIDO189 said:

المواد مكتوبه ولكن يوجد + بعد المواد زياده يعنى مثل عاوز

عربى + حساب+ جغرافيا   زى ده

تفضل اخي تم انشاء الكود لتنفيد طلبك بادن الله يكفي الظغط علر زر إزالة العلامات الزائدة 🤔

Sub Remove_additional_Tags()

    Dim WS As Worksheet, i As Long, _
        OneRng As Range, cell As Range, _
        CntText As String, tmp As String, _
        rCount As Long
    
    Set WS = ThisWorkbook.Sheets("ورقة2")
    Set OneRng = WS.Range("B7:B" & WS.Cells(WS.Rows.Count, "B").End(xlUp).Row)
    
    Application.ScreenUpdating = False
    rCount = 0
    
    For Each cell In OneRng
        CntText = cell.Value
        tmp = ""
        
        ' ****حساب عدد العلامات الأصلية*****
        Dim originalPlusCount As Long, newPlusCount As Long
        originalPlusCount = Len(CntText) - Len(Replace(CntText, "+", ""))
        
        ' *****إزالة علامات "+" المتتالية أو غير الضرورية******
        Dim src As String
        src = Trim(CntText)
        Do While InStr(src, " + +") > 0
            src = Replace(src, " + +", " + ")
        Loop
        If Left(src, 2) = " + " Then
            src = Mid(src, 3)
        End If
        If Right(src, 2) = " + " Then
            src = Left(src, Len(src) - 2)
        End If
        
        ' ****إزالة أي علامة "+" بعد آخر كلمة*****
        If Right(src, 1) = "+" Then
            src = Left(src, Len(src) - 1)
        End If
        
        Dim words() As String
        words = Split(src, " + ")
        
        For i = LBound(words) To UBound(words)
            If Trim(words(i)) <> "" Then
                If tmp <> "" Then
                    tmp = tmp & " + " & Trim(words(i))
                Else
                    tmp = Trim(words(i))
                End If
            End If
        Next i
   
   ' ****حساب عدد العلامات التي تمت إزالتها*****
        newPlusCount = Len(tmp) - Len(Replace(tmp, "+", ""))
        rCount = rCount + (originalPlusCount - newPlusCount)
        
        cell.Value = tmp
    Next cell
    
    Application.ScreenUpdating = True
    
    If rCount > 0 Then
     MsgBox "تمت إزالة" & " " & rCount & _
         " علامة غير مستخدمة بنجاح ", vbInformation
    Else
         MsgBox "لا يوجد علامات زائدة", vbInformation
    End If
End Sub

 

 

RS_ST_196 V3.xls

[أ / محمد صالح]

بعد إذن أخينا الفاضل @محمد هشام.

هذه دالة معرفة في vba مختصرة تفي بالغرض بإذن الله

Function masRemovePlus(txt As String) As String
txt = Trim(txt)
Do While Right(txt, 1) = "+"
    txt = Trim(Left(txt, Len(txt) - 1))
Loop
masRemovePlus = txt
End Function

ويمكن استدعاؤها كالتالي

=masRemovePlus(B7)

رغم أن معالجتي لمثل هذه الأمور تبدأ من الكود الذي يصدر هذا النص

بمعنى أدق تصحيح المعادلة التي تحدد مواد الرسوب حتى لا تكتب علامة زائد في غير موضعها

بالتوفيق

[محمد هشام.]

بارك الله فيك استاد @أ / محمد صالح

بالفعل هي دالة جميلة ومختصرة لاكن ربما المشكلة على ما أعتقد أن السائل يريد حدف العلامات الزائدة مع  بقاء البيانات في نفس العمود B

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

Sub Remove_additional_Tags()
Dim WS As Worksheet, i As Long, _
        OneRng As Range, cell As Range, _
        tmp As String, rCount As Long
        
    
    Set WS = ThisWorkbook.Sheets("ورقة2")
    
    Set OneRng = WS.Range("B7:B" & WS.Cells(WS.Rows.Count, "B").End(xlUp).Row)

    For Each cell In OneRng
        If Not IsEmpty(cell.Value) Then
            tmp = Trim(cell.Value)
            Do While Right(tmp, 1) = "+"
                tmp = Trim(Left(tmp, Len(tmp) - 1))
            Loop
            cell.Value = tmp
        End If
    Next cell
End Sub

 

RS_ST_196 V4.xls

[أ / محمد صالح]

8 ساعات مضت, محمد هشام. said:

الفعل هي دالة جميلة ومختصرة لاكن ربما المشكلة على ما أعتقد أن السائل يريد حدف العلامات الزائدة مع  بقاء البيانات في نفس العمود B

لا يوجد ما يمنع أن ينقل قيم هذه المعادلة من العمود الجديد إلى العمود B ويحذف العمود الجديد

الكمبيوتر يتميز بالمرونة فلكل مشكلة الكثير من الحلول المهم أن يبدع الإنسان ويفكر

بالتوفيق للجميع