العثور على أحرف الغير موجودة

[zozzz]

سلام علیکم و رحمه الله

كيف يمكن العثور على أحرف الغير موجودة فی الجمله؟

مثال : بسم الله الرحمن الرحیم

حروف الغیر موجوده : ت ث ج خ د ذ ز ش ...

و شکرا لمساعدتکم

 

[ابو البشر]

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

اهلا بك

جرب هذا

Private Sub cmdExtract_Click()
    Dim strInput As String
    Dim strAlphabet As String
    Dim strOutput As String
    Dim i As Integer
    Dim char As String
    Dim inputLetters As Collection
    Dim missingCount As Integer
    
    strAlphabet = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي"
    strInput = Me.txtInput.Value
    
    Set inputLetters = New Collection
    
    For i = 1 To Len(strInput)
        char = Mid(strInput, i, 1)
        If InStr(1, strAlphabet, char, vbBinaryCompare) > 0 Then
            On Error Resume Next
            inputLetters.Add char, char
            On Error GoTo 0
        End If
    Next i
    
    strOutput = ""
    missingCount = 0
    
    For i = 1 To Len(strAlphabet)
        char = Mid(strAlphabet, i, 1)
        On Error Resume Next
        inputLetters.Item (char)
        If Err.Number <> 0 Then
            If missingCount > 0 Then
                strOutput = strOutput & "'، '"
            End If
            strOutput = strOutput & "'" & char & "'"
            missingCount = missingCount + 1
        End If
        On Error GoTo 0
    Next i
    
    If missingCount = 0 Then
        Me.txtOutput.Value = "لا توجد حروف مفقودة"
    Else
        Me.txtOutput.Value = strOutput
    End If
    
    Set inputLetters = Nothing
End Sub

 

[zozzz]

شکرا جزیلا علی الرد اخی " ابو البشر "

بس هل من الممکن تبدیل هذا الکود الی public function  حتی نضیف له Module ؟؟

[ابو البشر]

5 دقائق مضت, zozzz said:

شکرا جزیلا علی الرد اخی " ابو البشر "

بس هل من الممکن تبدیل هذا الکود الی public function  حتی نضیف له Module ؟؟

 

تفضل 

Public Function GetMissingArabicLetters(ByVal InputText As String) As String
    Dim strAlphabet As String
    Dim strOutput As String
    Dim i As Integer
    Dim char As String
    Dim inputLetters As Collection
    Dim missingCount As Integer
    
    ' الحروف العربية الأبجدية (الألف إلى الياء)
    strAlphabet = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي"
    
    ' إنشاء مجموعة لتخزين الحروف الموجودة
    Set inputLetters = New Collection
    
    ' إضافة كل حرف عربي موجود في النص إلى المجموعة (منع التكرار)
    For i = 1 To Len(InputText)
        char = Mid(InputText, i, 1)
        If InStr(1, strAlphabet, char, vbBinaryCompare) > 0 Then
            On Error Resume Next
            inputLetters.Add char, char
            On Error GoTo 0
        End If
    Next i
    
    ' بناء النتيجة بالشكل المطلوب (حرف، حرف، حرف)
    strOutput = ""
    missingCount = 0
    
    For i = 1 To Len(strAlphabet)
        char = Mid(strAlphabet, i, 1)
        On Error Resume Next
        inputLetters.Item (char)  ' محاولة الوصول إلى الحرف
        If Err.Number <> 0 Then   ' إذا حدث خطأ فهذا يعني أن الحرف غير موجود
            If missingCount > 0 Then
                strOutput = strOutput & "، "   ' فاصلة عربية + مسافة
            End If
            strOutput = strOutput & char
            missingCount = missingCount + 1
        End If
        On Error GoTo 0
    Next i
    
    ' النتيجة النهائية
    If missingCount = 0 Then
        GetMissingArabicLetters = "لا توجد حروف مفقودة"
    Else
        GetMissingArabicLetters = strOutput
    End If
    
    ' تنظيف الذاكرة
    Set inputLetters = Nothing
End Function

استدعيه بهذا الشكل

Private Sub cmdExtract_Click()
    Me.txtOutput.Value = GetMissingArabicLetters(Me.txtInput.Value)
End Sub

 

[zozzz]

تسلم تسلم 🙏

احسنتم 💐