بسم الله والحمد لله والصلاة والسلام على رسول الله
أهلا ومرحبا بكم إخوانى الكرام من جديد
اليوم أقدم لكم دالة تعد تطوير وتحسين لدالة TRIM
<hr arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " />من المعروف أن دالة TRIM تقوم بتقليم أو تنظيف النص من المسافات الزائدة
ولكن ماذا لو أردنا التقليم على أساس حرف غير المسافة
أو حتى تحديد أماكن التنظيف بكامل النص أو بشكل جزئى
فى الغالب نلجأ لصيغ مركبة <br arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " />

<hr arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " />لذلك تم برمجة الدالة TrimPro والتى تقوم بتقليم النص وفقاً لتحديد حرف معين والأسلوب المتبع لذلك
ويمكن استخدام الدالة مع الصفيف وايضا نتائج الدالة كصفيف لا يشترط الضغط على Ctrl+Shift+Enter
الا فى حالة ادخلت الدالة مع صيغ اخرى تستعمل فيها المصفوفات

<hr arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " />الان بناء الدالة كالتالى

=TrimPro(string,[clean],[at])

<br arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " />
أول باراميتر اجبارى الادخال وهو النص المراد تقليم الحرف المحدد منه
ثانى باراميتر اختيارى الادخال وهو الحرف المراد تقليمة
ثالث باراميتر اختيارى الادخال وهو أسلوب التقليم [ 1- كلى ، 2- أيسر ، 3- أوسط ، 4- أيمن ، 5- أطراف]

<hr arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " /> وكل ذلك له امثله عملية داخل ملف العمل

الان ناتى لمثال عملى بسيط كالتالى
اكتب رقم [ eslam abdullah ] فى الخلية A1 ثم اكتب الصيغة التالية




=TrimPro(A1," ",5) <br arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " />
هنا سيتم التقليم على أساس المسافة من الأطراف فقط
وبإمكانك تجربة المزيد للدالة المعرفة بالملف المرفق

<hr arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " />وكود الدالة كالتالى

Function TrimPro(str, Optional c$ = " ", Optional at As Byte = 1)
'Programming by Eslam Abdullah
On Error Resume Next
Dim arr$(), txt, rw&, cl%, x&, y%
If at > 0 And at < 6 Then c = String(1, c): str = str Else TrimPro = CVErr(xlErrNum): Exit Function
rw = UBound(str, 1) - 1: cl = UBound(str, 2) - 1
ReDim arr(rw, cl)
With CreateObject("VBScript.RegExp"): .Global = True
    .Pattern = Array("", "^" & c & "+|" & c & "+$|" & c & "+(" & c & ")", "^" & c & "+", "([^" & c & "])" & c & "+(?=[^" & c & "])", c & "+$", "^" & c & "+|" & c & "+$")(at * -(c <> ""))
    c = Array("", "$1", "", "$1" & c, "", "")(at * -(c <> ""))
    If rw + cl = 0 Then txt = str
    For Each txt In str
        arr(x, y) = .Replace(txt, c)
        x = (x + 1) * -(x < rw): y = y - (x = 0)
    Next txt
    TrimPro = arr
End With
End Function

<hr arabic="" droid="" kufi="" style="color: rgb(0, 0, 0); font-family: " /> كان معكم ومعنا ومعاهم برضوا
أخوكم فى الله اسلام عبدالله
دمتم فى حفظ الله ورعايته