الدالة، تتطلب النص وترتيب الدرجة في النص 1 للأول 2 للثاني:
Option Explicit
Function GetDeg(ByVal inText As String, DegSeq As Byte) As Variant
Dim Pos1 As Integer, Pos2 As Integer
Dim Deg As Variant
GetDeg = ""
If DegSeq < 1 Or DegSeq > 2 Then Exit Function
Do While InStr(1, inText, " ") > 0
inText = Replace(inText, " ", " ")
Loop
Pos2 = InStr(1, inText, " درج")
If Pos2 = 0 Then Exit Function
If DegSeq = 2 Then
Pos2 = InStr(Pos2 + 1, inText, " درج")
If Pos2 = 0 Then Exit Function
End If
Pos1 = InStrRev(inText, " ", Pos2 - 1)
If Pos1 > 0 And Pos2 > 0 Then
Deg = Mid(inText, Pos1 + 1, Pos2 - Pos1 - 1)
End If
If IsNumeric(Deg) Then GetDeg = Val(Deg)
End Function
ضفه في ملفك أو انشئ ملف جديد ووحدة نمطية جديدة والصق الشفرة/الكود