هديه هَدِيَّةٌ: مُطَهَّرُ النُّصُوصِ الْعَرَبِيَّةِ ( ازالة المسافات الزائدة و التشكيل و تنظيف النصوص - و توحيد الاشكال المختلفة للأحرف )

[ابو جودي]

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

اليوم اقدم لك وظيفة مُطَهَّرُ النُّصُوصِ الْعَرَبِيَّةِ

غاية فى الروعة ومكتوبة بعناية واحترافية للحصول على اكبر قدر ممكن من الدقة فى الاداء والمرونة فى التناول عند الاستدعاء

حيث أن الكود يعالج النصوص العربية بطريقة مرنة مع التركيز على ازالة المسافات وتنظيف النص و إزالة التشكيل و توحيد الاحرف ومعالجتها

يعتمد الكود خيارين للعمل (إزالة المسافات أو التطبيع "توحيد الاشكال المختلفة للاحرف" ) مما يجعله قابلاً للتخصيص بناءً على الحاجة

على سبيل المثال 

النص الاصلى والذى نريد معالجته : "تَجْرِبَةُ    إِشْرَافٍ     عَلَى? بَعْضِ الْأَمَاكِنِ أَوْ الْمَكَانِ رَقْمٌ  101"
الحالات التى يمكن الحصول عليها من معالجة النص السابق هى 

ازالة المسافات فقط وتنظيف النص مع الابقاء على الارقام بدون التطبيع :  تجربة إشراف على بعض الأماكن أو المكان رقم 101

ازالة المسافات وتنظيف النص مع الابقاء على الارقام مع التطبيع :  تجربه اشراف علي بعض الاماكن او المكان رقم 101

ازالة المسافات وتنظيف النص مع ازالة الارقام مع التطبيع :  تجربه اشراف علي بعض الاماكن او المكان رقم 

ازالة المسافات فقط وتنظيف النص مع ازالة الارقام بدون التطبيع : تجربة إشراف على بعض الأماكن أو المكان رقم 

الكود

' Function: ArabicTextSanitizer
' Purpose: Sanitizes Arabic text by removing non-Arabic characters, optionally normalizing the text,
'          removing diacritics (harakat), and optionally removing numeric characters or spaces.
' Parameters:
'    inputText (String): The Arabic text to be sanitized. It can contain Arabic characters, non-Arabic characters,
'                        diacritics, and numeric values.
'    normalize (Boolean): Optional. If True, the text will be normalized by replacing specific Arabic characters
'                          with their standardized equivalents (default is True).
'    RemoveNumbers (Boolean): Optional. If True, numeric characters (0-9) will be removed from the text (default is True).
'    removeSpaces (Boolean): Optional. If True, all spaces in the text will be removed (default is False).
' Returns:
'    String: The sanitized Arabic text with optional normalization, removal of numbers, and spaces.
'
' Example Use Cases:
' 1. Remove spaces only and clean the text while keeping numbers without normalization:
'    ' Removes spaces from the text while keeping numbers and without normalizing the text.
'    ' Example: ArabicTextSanitizer(inputArabicText, False, False, True)
'
' 2. Remove spaces and clean the text while keeping numbers and normalizing:
'    ' Normalizes the text and removes spaces, while keeping numbers.
'    ' Example: ArabicTextSanitizer(inputArabicText, True, False, True)
'
' 3. Remove spaces and clean the text while removing numbers and normalizing:
'    ' Normalizes the text, removes spaces, and removes numbers.
'    ' Example: ArabicTextSanitizer(inputArabicText, True, True, True)
'
' 4. Remove spaces only and clean the text while removing numbers without normalization:
'    ' Removes spaces and numbers, but does not normalize the text.
'    ' Example: ArabicTextSanitizer(inputArabicText, False, True, True)
'
Public Function ArabicTextSanitizer(inputText As String, Optional normalize As Boolean = True, Optional RemoveNumbers As Boolean = True) As String
    On Error GoTo ErrorHandler

    ' Ensure the input is valid (non-empty and not null)
    If Nz(inputText, "") = "" Then
        ArabicTextSanitizer = ""
        Exit Function
    End If
    
    
    ' Initialize the sanitizedText with the trimmed input
    Dim sanitizedText As String
    sanitizedText = Trim(inputText)

    ' Step 1: Normalize the text if requested
    If normalize Then
        ' Define character replacement pairs for normalization
        Dim charReplacementPairs As Variant
        charReplacementPairs = Array( _
            Array(ChrW(1573), ChrW(1575)), _
            Array(ChrW(1571), ChrW(1575)), _
            Array(ChrW(1570), ChrW(1575)), _
            Array(ChrW(1572), ChrW(1608)), _
            Array(ChrW(1574), ChrW(1609)), _
            Array(ChrW(1609), ChrW(1610)), _
            Array(ChrW(1577), ChrW(1607)), _
            Array(ChrW(1705), ChrW(1603)), _
            Array(ChrW(1670), ChrW(1580)))

        ' Apply replacements for character normalization
        Dim pair As Variant
        For Each pair In charReplacementPairs
            sanitizedText = Replace(sanitizedText, pair(0), pair(1))
        Next

        ' Step 2: Remove diacritics (harakat) from the text
        Dim diacritics As String
        diacritics = ChrW(1600) & ChrW(1611) & ChrW(1612) & ChrW(1613) & ChrW(1614) & ChrW(1615) & ChrW(1616) & ChrW(1617) & ChrW(1618)
        Dim i As Integer
        For i = 1 To Len(diacritics)
            sanitizedText = Replace(sanitizedText, Mid(diacritics, i, 1), "")
        Next
    End If

    ' Step 3: Retain only Arabic characters, spaces, and optionally numbers
    Dim tempChars() As String
    Dim charIndex As Long
    Dim intChar As Integer
    Dim finalResultText As String

    ' Iterate through each character in the sanitized text
    For i = 1 To Len(sanitizedText)
        intChar = AscW(Mid(sanitizedText, i, 1))

        ' Check for Arabic characters (range for Arabic characters and spaces)
        If intChar = 32 Or _
           (intChar >= 1569 And intChar <= 1594) Or _
           (intChar >= 1601 And intChar <= 1610) Or _
           (intChar >= 1648 And intChar <= 1649) Then
            ReDim Preserve tempChars(charIndex)
            tempChars(charIndex) = ChrW(intChar)
            charIndex = charIndex + 1
        ' Optionally, check for numbers if RemoveNumbers is False
        ElseIf Not RemoveNumbers And (intChar >= 48 And intChar <= 57) Then
            ReDim Preserve tempChars(charIndex)
            tempChars(charIndex) = ChrW(intChar)
            charIndex = charIndex + 1
        End If
    Next

    ' Step 4: Join the valid characters into a final result text
    finalResultText = Join(tempChars, "")

    ' Step 5: Remove extra spaces (multiple consecutive spaces replaced with a single space)
    finalResultText = Replace(finalResultText, "  ", " ") ' Improved space replacement
    Do While InStr(finalResultText, "  ") > 0
        finalResultText = Replace(finalResultText, "  ", " ")
    Loop

    ' Step 6: Remove special characters (if needed)
    finalResultText = Replace(finalResultText, "*", "")
    finalResultText = Replace(finalResultText, "#", "")
    finalResultText = Replace(finalResultText, "@", "")
    finalResultText = Replace(finalResultText, ",", "")
    
    ' Return the sanitized text
    If Len(Trim(Nz(finalResultText, ""))) = 0 Then
        ArabicTextSanitizer = vbNullString
    Else
        ArabicTextSanitizer = finalResultText
    End If

    Exit Function

ErrorHandler:
    Debug.Print "Error in ArabicTextSanitizer: " & Err.Description
    ArabicTextSanitizer = ""
End Function

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

' Subroutine: TestArabicTextSanitizer
' Purpose: Demonstrates and validates the functionality of the ArabicTextSanitizer function.
'          It shows various test cases for sanitizing Arabic text with diacritics, non-Arabic characters, and numbers.

Sub TestArabicTextSanitizer()
    ' Declare input and result variables
    Dim inputArabicText As String
    Dim result As String

    ' Example input text with diacritics, non-Arabic characters, and numbers
    inputArabicText = "تَجْرِبَةُ * فَاحِصِهِ # @ , لِعَمَلٍ أَلِكَوَّدِ فِىَّ شَتِّيَّ  3ألْإِشْكآل " & _
                      "إِشْرَافٍ      عَلَى? بَعْضِ الْأَمَاكِنِ  أَوْ الْمَكَانِ رَقْمٌ  5  و  الْمَكَانِ   رَقْمٌ 100100ِ لمعرفة كيف سيعمل ها ألكود"
    
    ' Display the original input Arabic text
    Debug.Print "Input Arabic Text: " & inputArabicText

    ' Test case 1: Remove diacritics without normalization
    ' This case removes diacritics (harakat) without altering normalization or removing numbers
    result = ArabicTextSanitizer(inputArabicText, False, False)
    Debug.Print "Filtered Arabic Text (case 1 - Remove diacritics without normalization): " & result

    ' Test case 2: Normalize and remove diacritics
    ' This case normalizes the text (e.g., converting similar Arabic characters) and removes diacritics
    result = ArabicTextSanitizer(inputArabicText, True, False)
    Debug.Print "Normalized Arabic Text and Removed Diacritics (case 2): " & result

    ' Test case 3: Remove numbers as well (Optional argument set to True to remove numbers)
    ' This case normalizes the text and removes both diacritics and numbers
    result = ArabicTextSanitizer(inputArabicText, True, True)
    Debug.Print "Text without Numbers and Normalized (case 3): " & result

    ' Test case 4: Just remove diacritics without normalization or removing numbers
    ' This case removes diacritics and numbers, but does not normalize the text
    result = ArabicTextSanitizer(inputArabicText, False, True)
    Debug.Print "Text without Diacritics and Numbers (case 4): " & result
End Sub

واخيرا اليكم مرفق للتجربة

 

Arabic Text Sanitizer.accdb

[ابو جودي]

سوف أبين اهمية الوظيفة السابقة فى موضوع مستقل وسوف انوه هنا عن هذا الموضوع 

وذلك لما فيها من فائدة كبيرة و اهمية عظيمة عند استخدام الفرز والتصفيه وعمل البحث داخل البيانات 


الموضوع  >----->>   من هنا

[ابوخليل]

ما شاء الله لا قوة الابالله

عطاء مستمر .. كل يوم جديد .. 

هدية مقبولة .. تقبل الله منك 

 عمل احترافي متقن واختصار غير مخل .. بل اختصار مع الاحاطة بكافة الاحتمالات 

البحث بين الحروف والجمل العربية سبب أرقاً للمبرمجين من وقت ظهور الحاسبات .

زادك الله علما وبارك  فيك ووفقك

[عمر ضاحى]

الف شكر يا هندسه على الهديه والابداع 

حزاك الله كل خير

 

[at_aziz]

بارك الله فيك وجزاك الله خير   

وهديه مقبوله هذا الابداع الرائع

وفقك الله