بسم الله الرحمن الرحيم

اقدم لكم دالة معرفة لفصل القيم النصية عن القيم الرقمية


كل ما علينا هو ان نضيف هذ الكود للدالة المعرفة بموديل كما بالصورة



كود الدالة

Public Function SplitText(WorkRng As Range, Number As Boolean) As String &nbsp;<br />
&nbsp; &nbsp;Dim xLen As Long &nbsp;<br />
&nbsp; &nbsp;Dim xStr As String &nbsp;<br />
&nbsp; &nbsp;xLen = VBA.Len(WorkRng.Value) &nbsp;<br />
&nbsp; &nbsp;For i = 1 To xLen &nbsp;<br />
&nbsp; &nbsp; &nbsp;xStr = VBA.Mid(WorkRng.Value, i, 1) &nbsp;<br />
&nbsp; &nbsp; &nbsp;If ((VBA.IsNumeric(xStr) And Number) Or (Not (VBA.IsNumeric(xStr)) And Not (Number))) Then &nbsp;<br />
&nbsp; &nbsp; &nbsp; &nbsp;SplitText = SplitText + xStr &nbsp;<br />
&nbsp; &nbsp; &nbsp;End If &nbsp;<br />
&nbsp; &nbsp;Next &nbsp;<br />
&nbsp;End Function &nbsp;<br />

طريقة كتابة الدالة


للقيم النصية

  =SplitText($A2;0)

أو

=SplitText($A2;False)<br />
<br />

للقيم الرقمية

=SplitText($A2;1)<br />
<br />

أو

=SplitText($A2;TRUE)<br />
<br />

كود اخر لفصل كل قيمة على حدا

الكود المستخدم للقيمتين

 Sub split_Text()  
   Dim xLen As Long  
   Dim xStr As String  
   Dim Rng As Range  
   For Each Rng In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)  
     xLen = VBA.Len(Rng.Value)  
     Rng.Offset(, 4).ClearContents  
     For i = 1 To xLen  
       xStr = VBA.Mid(Rng.Value, i, 1)  
       If Not (VBA.IsNumeric(xStr)) And Not (Number) Then  
         Rng.Offset(, 4) = Rng.Offset(, 4) + xStr  
       End If  
     Next i  
   Next Rng  
 End Sub  
 Sub Split_NUM()  
   Dim xLen As Long  
   Dim xStr As String  
   Dim Rng As Range  
   For Each Rng In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)  
     xLen = VBA.Len(Rng.Value)  
     Rng.Offset(, 5).ClearContents  
     For i = 1 To xLen  
       xStr = VBA.Mid(Rng.Value, i, 1)  
       If (VBA.IsNumeric(xStr)) And Not (Number) Then  
         Rng.Offset(, 5) = Rng.Offset(, 5) & xStr  
       End If  
     Next i  
   Next Rng  
 End Sub

<code> </code>
لتحميل الملف اضغط هنا
ياسر العربي