أخي الكريم تامر
بعد معاناة مع الملف ومحاولة الوصول لحل بطرق مختلفة ، اتضح لي أن هذه ليست أرقام بالمرة لذا باءت كل المحاولات بالفشل .. إلى أن وفقني الله لمعرفة أن هذه الأرقام عبارة عن أرقام باللغة العربية بنظام الـ Unicode لذا فهي لا تعتبر أرقام بالشكل الظاهر ، فقمت بعمل دالة معرفة لتحويلها إلى أرقام أولاً ثم دالة معرفة أخرى لجمع هذه الأرقام
ضع الأكواد التالية في موديول عادي .. يمكنك استخدام الدالة المعرفة في محرر الأكواد أو يمكن استخدامها في ورقة العمل كما سأوضح لك
CODE
Sub Test_SumNumbers_UDF()
MsgBox SumNumbers(Range("K5:K14"))
End Sub
Function SumNumbers(ByVal rng As Range)
Dim c As Range, t As Double
For Each c In rng
If c.Value <> Empty Then
t = t + CDbl(Replace(ReplaceArabicNumbers(c.Value), ",", ".") * 1)
End If
Next c
SumNumbers = t
End Function
Function ReplaceArabicNumbers(strInput As String) As String
Dim numberArray, i As Long
numberArray = Array(ChrW(&H660), "0", ChrW(&H661), "1", ChrW(&H662), "2", ChrW(&H663), "3", ChrW(&H664), "4", ChrW(&H665), "5", ChrW(&H666), "6", ChrW(&H667), "7", ChrW(&H668), "8", ChrW(&H669), "9")
ReplaceArabicNumbers = strInput
For i = 0 To 18 Step 2
ReplaceArabicNumbers = Replace(ReplaceArabicNumbers, numberArray(i), numberArray(i + 1))
Next i
End Function
مشكلة في جمع الخلايا
