أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
مالك ماريه ali mohamed ali-- لا تميز خلال هذه الفترة YasserKhalil جمع خلايا بها معادلات اكسيل اسئله واجابات


اعلان هنا
ألعاب فلاش أون لاين
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا



أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





كود إستخراج اسم ولى الأمر من الأسماء المركبة

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



19-07-2019 06:31 مساء
محسن أحمد عبد الرازق
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 17-07-2019
رقم العضوية : 13856
المشاركات : 3
الجنس : ذكر
تاريخ الميلاد : 13-2-1975
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 10
الاعجاب : 0
 offline 

لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب أرجو شرح كود إستخرج اسم ولى الأمر من الأسماء المركبة ولسيادتكم جزيل الشكر
 
 
 
  ولى الأمر.xlsx   تحميل xlsx مرات التحميل :(1)
الحجم :(13.176) KB







19-07-2019 06:59 مساء
مشاهدة مشاركة منفردة [1]
ali mohamed ali
menu_open
مشرف على منتدى الاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1383
الدولة : مصر
الجنس : ذكر
الدعوات : 1
يتابعهم : 0
يتابعونه : 57
قوة السمعة : 6278
الاعجاب : 939
 Online 
look/images/icons/i1.gif كود إستخراج اسم ولى الأمر من الأسماء المركبة
اهلا بك اخى الكريم فى المنتدى-تم عرض الحل داخل الملف بطريقتين :
اولاً: بالمعادلات,حيث يمكنك استخدام هذه المعادلة
=IF(A2="","",MID(A2,FIND(" ",A2,5)+1,LEN(A2)))

ثانياً : بدالة معرفة للأستاذ عبدالله باقشير له منا كل المحبة والإحترام
Option Explicit

'         ÈÓã Çááå ÇáÑÍãä ÇáÑÍíã            "
'         ********************           "

'       ÏÇáÉ ÇÓÊÎÑÇÌ ÇÓã æáí ÇáÃãÑ         "
'========================================"
'     True =    kh_First  ÇÐÇ ßÇä        "
'        Çæ Çí ÑÞã ÛíÑ ÇáÕÝÑ              "
'     ÊÞæã ÈÇÓÊÎÑÇÌ ÇáÇÓã ÇáÇæá            "
'========================================"
'    íÇãßÇäíÉ ãÚÇáÌÉ ÇáÇÓã ÇáãÑßÈ ÇáÇæá      "
'    ÊáÞÇÆíÇð ÍÓÈ  ãÚÇííÑ ãÚÑÝÉ áÏíåÇ      "
'      Kh_Father_Replace  Ýí ÇáÏÇáÉ       "
'       æíãßäß ÇÖÇÝÉ Çí ãÚíÇÑ ÂÎÑ         "
'        ÈÌÇäÈ ÇáãÚÇííÑ ÇáãæÌæÏÉ             "
'          MyArray  Ýí ÇáãÊÛíÑ              "
'      ãÚ ãÑÇÚÇÉ æÌæÏ ÝÑÇÛ ÈÏÇíÉ
'           Çæ äåÇíÉ ÇáãÚíÇÑ
'========================================"
'-----------------------------------------------------------------

Function Kh_Father_Name(ByVal Name As String, Optional kh_First As Boolean) As String
Dim KhString As String, Kh_Mid As String, Kh_Rep  As String
Dim KhMyNo As Integer

    On Error GoTo Err_Kh_Father_Name

    If IsEmpty(Name) Then GoTo Err_Kh_Father_Name
    KhString = Kh_Father_Replace(Trim(Name)) & " "
    KhMyNo = InStr(1, KhString, " ", 1)
    If kh_First Then Kh_Mid = Trim(Mid(KhString, 1, KhMyNo)) Else _
    Kh_Mid = Trim(Mid(KhString, KhMyNo, Len(KhString)))
    Kh_Rep = Replace(Kh_Mid, "^", " ")
    Kh_Father_Name = Kh_Rep
    
    Exit Function

Err_Kh_Father_Name:
     Kh_Father_Name = ""
End Function
Private Function Kh_Father_Replace(ByVal Kh_Sub As String) As String
Dim MyArray, Ar
Dim Sn As String, Re As String
'====================================================
' íãßäß ÇÖÇÝÉ Çí ãÚíÇÑ ÂÎÑ åäÇ ÈÌÇäÈ ÇáãÚÇííÑ ÇáãæÌæÏÉ

MyArray = Array("ÚÈÏ ", "ÃÈæ ", "ÇÈæ ", "Âá ", " Çááå" _
    , " ÇáÏíä", " ÇáÅÓáÇã", " ÇáÇÓáÇã", " ÇáÍÞ")

'====================================================
Sn = Kh_Sub
For Each Ar In MyArray
    Re = Replace(Ar, " ", "^")
    Sn = Replace(Sn, Ar, Re)
Next
Kh_Father_Replace = Sn
End Function

Function NoSpaces(InName As String) As String
Dim NewName As String, ThePrevStr As String, TheStr As String
Dim i As Integer
InName = Trim(InName)
For i = 1 To Len(InName)
    TheStr = Mid(InName, i, 1)
    If TheStr = " " And ThePrevStr = " " Then TheStr = ""
    If TheStr <> "" Then ThePrevStr = TheStr
    NewName = NewName & TheStr
Next
NoSpaces = NewName
End Function

Function PartsCount(InName As String) As Integer
If NoSpaces(InName) = "" Then Exit Function
Dim i As Integer, U As Integer
Do
    i = InStr(i + 1, InName, " ", 1)
    If i = 0 Then Exit Do Else U = i
Loop
PartsCount = U + 1
End Function
Function GoodPartOfName(InName As String, NumberOfPart As Integer) As String
'ÊÓÊÎÏã åÐå ÇáÏÇáÉ áÊÍÏíÏ ÇáÌÒÁ ÇáãØáæÈ ãä ÇáÅÓã
'æÐáß Úä ØÑíÞ ÊÍÏíÏ ÑÞãå Ýí NumberOfPart
'ÇáÇÓã ÇáÇæá = 1
'ÇáËÇäí = 2
'.....æåßÐÇ
Dim sCount As Integer, i As Integer, U As Integer, F As Long
Dim ThePart() As String, RealPart() As String
Dim SpecialNames() As String, SpecialKinds() As Byte, SpecialCounts As Long
Dim SpecialPart As Variant

InName = NoSpaces(Kh_Father_Replace(Trim(InName)) & " ")
If InName = "" Then Exit Function

sCount = PartsCount(InName)
If NumberOfPart > sCount Then Exit Function
If NumberOfPart < sCount Then sCount = sCount + 1

ReDim ThePart(1 To sCount)
ReDim RealPart(1 To sCount)
For i = 1 To sCount
    ThePart(i) = PartOfName(InName, i)
    If i = 1 Then
        SpecialPart = "'" & ThePart(i) & "'"
    Else
        SpecialPart = SpecialPart & "," & "'" & ThePart(i) & "'"
    End If
Next i

If SpecialCounts <> 0 Then
    i = 0
    ReDim SpecialNames(1 To SpecialCounts)
    ReDim SpecialKinds(1 To SpecialCounts)
End If
For i = 1 To sCount
SpecialPart = Null
If SpecialCounts <> 0 Then
    For F = 1 To SpecialCounts
        If ThePart(i) = SpecialNames(F) Then SpecialPart = SpecialKinds(F)
    Next F
End If
If IsNull(SpecialPart) Then
    U = U + 1
    RealPart(U) = ThePart(i)
ElseIf SpecialPart = 2 Then
    U = U + 1
    RealPart(U) = ThePart(i) & " " & ThePart(i + 1)
    i = i + 1
ElseIf SpecialPart = 1 Then
    If i = 1 Then
        U = U + 1
        RealPart(U) = ThePart(i)
    ElseIf InStr(1, RealPart(U), " ", 1) <> 0 Then
        U = U + 1
        RealPart(U) = ThePart(i)
    Else
        U = U
        RealPart(U) = RealPart(U) & " " & ThePart(i)
    End If
End If
Next i

GoodPartOfName = Replace(RealPart(NumberOfPart), "^", " ")

End Function

Function PartOfName(InName As String, NumberOfPart As Integer) As String
Dim TheSpaceNumber As Byte
Dim i As Integer, U As Integer

InName = NoSpaces(InName)
PartOfName = ""
If InName = "" Then Exit Function

Do
    U = i
    i = InStr(i + 1, InName, " ", 1)
    If i <> 0 Then
        TheSpaceNumber = TheSpaceNumber + 1
        If TheSpaceNumber = NumberOfPart Then Exit Do
    ElseIf TheSpaceNumber + 1 = NumberOfPart Then
        i = Len(InName) + 1
        Exit Do
    Else
        Exit Function
    End If
Loop
    
    PartOfName = Trim(Mid(InName, U + 1, i - U - 1))
End Function

Public Function StName(TheName As String)
'ÇáÇÓã ÇáÃæá
StName = GoodPartOfName(TheName, 1)

End Function


Public Function FatherName(TheName As String)
'ÇÓã ÇáÃÈ
Dim MyFName As String
If Len(GoodPartOfName(TheName, 3)) > 0 Then
MyFName = GoodPartOfName(TheName, 2)
Else
MyFName = ""
End If
FatherName = MyFName

End Function

Public Function StGrndName(TheName As String)
'ÇáÌÏ ÇáÃæá
Dim MyStGName As String
If Len(GoodPartOfName(TheName, 4)) > 0 Then
MyStGName = GoodPartOfName(TheName, 3)
Else
MyStGName = ""
End If
StGrndName = MyStGName
End Function

Public Function NdGrndName(TheName As String)
'ÇáÌÏ ÇáËÇäí
Dim MyNdGName As String
If Len(GoodPartOfName(TheName, 5)) > 0 Then
MyNdGName = GoodPartOfName(TheName, 4)
Else
MyNdGName = ""
End If
NdGrndName = MyNdGName

End Function

Public Function LastName(TheName As String)
'ÇááÞÈ
Dim MyLastName As String
If Len(GoodPartOfName(TheName, 5)) > 0 Then
MyLastName = GoodPartOfName(TheName, 5)
ElseIf Len(GoodPartOfName(TheName, 4)) > 0 Then
MyLastName = GoodPartOfName(TheName, 4)
ElseIf Len(GoodPartOfName(TheName, 3)) > 0 Then
MyLastName = GoodPartOfName(TheName, 3)
Else
MyLastName = GoodPartOfName(TheName, 2)
End If
LastName = MyLastName
End Function




وهذا هو الملف
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

 
 
 
  ولى الأمر.rar   تحميل rar مرات التحميل :(16)
الحجم :(28.168) KB


أثارت هذه المشاركة إعجاب: YasserKhalil، Eslam Abdullah، abdulwahed catran، السعيد الجزائري،


توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله


20-07-2019 09:45 مساء
مشاهدة مشاركة منفردة [2]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 429
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 17
قوة السمعة : 3395
الاعجاب : 291
 offline 
look/images/icons/i1.gif كود إستخراج اسم ولى الأمر من الأسماء المركبة
اذهب الى هذا العنوان وخذ الكود من هناك وقم بتعديله ليتناسب مع المعطيات عندك
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

أثارت هذه المشاركة إعجاب: YasserKhalil،




31-07-2019 08:01 صباحا
مشاهدة مشاركة منفردة [3]
محسن أحمد عبد الرازق
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 17-07-2019
رقم العضوية : 13856
المشاركات : 3
الجنس : ذكر
تاريخ الميلاد : 13-2-1975
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 10
الاعجاب : 0
 offline 
look/images/icons/i1.gif كود إستخراج اسم ولى الأمر من الأسماء المركبة

شكراً على إهتمامك وردك يا أستاذ على 



ولقد إستخدمت المعادلة للسهولة  ولكننى كنت أود أنأعرف كيفية إستخدام الكود لأننى كنت قد أتيت به ولم أتمكن من إستخدامه ولكم منا جزيل الشكر








31-07-2019 09:58 صباحا
مشاهدة مشاركة منفردة [4]
ali mohamed ali
menu_open
مشرف على منتدى الاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1383
الدولة : مصر
الجنس : ذكر
الدعوات : 1
يتابعهم : 0
يتابعونه : 57
قوة السمعة : 6278
الاعجاب : 939
 Online 
look/images/icons/i1.gif كود إستخراج اسم ولى الأمر من الأسماء المركبة
كل حاجة موجودة بالملف يمكنك الإطلاع عليها ولماذا كل هذا التأخير فى الرد ؟!!!!
نسيت الموضوع



توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
ضبط معادلة إستخراج اجمالى المبيعات لكل شهر هانى على
4 484 الصقر

الكلمات الدلالية
المركبة ، الأسماء ، الأمر ، إستخراج ،


 







اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 11:33 صباحا

أعلن هنا
أعلن هنا
أعلن هنا