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

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


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





تعديل كود جلب اسماء الشيتات وعناوين الخلايا

السلام عليكم لدي هذا الكود يعمل جيدا لكن المشكلة انه يجب ان تكون القيم مطابقة في جميع الاعمدة ..



19-06-2020 06:40 مساء
المبتدأ
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 299
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 2
قوة السمعة : 244
 offline 

السلام  عليكم  
لدي  هذا   الكود  يعمل   جيدا    لكن  المشكلة    انه  يجب   ان  تكون    القيم  مطابقة  في  جميع  الاعمدة  في كل  الشيتات      حيث   لا  يتم  جلب  البيانات   في  الشيت  الاخير  اذاكان  احد  الاعمدة  مختلف  عن  الاخر   بمعنى   اا كانت   في  العمود  a  في  الشيت 1   ff    وغير  موجودة  في   الشيت الثاني  للعمود b     وغير  موجودة  في  الشيت  الثالث   في  العمود c      لن  يجلب  البيانات 
Sub Test()
Dim Temp(), i As Long, Fnd As Range, ws As Worksheet
ReDim Temp(1 To Sheets.Count - 1, 1 To 3)
For Each ws In ThisWorkbook.Sheets
    If Not ws.Name = "result" Then
        With ws
            Set Fnd = .UsedRange.Find(sheet4.Range("A2"), , xlValues, xlWhole)
            If Not Fnd Is Nothing Then
                i = i + 1: Temp(i, 1) = .Name: Temp(i, 2) = Fnd.Address: Temp(i, 3) = sheet4.Range("A2")
            End If
        End With
    End If
Next ws
If Fnd Is Nothing Then
    MsgBox "NO MATCHES"
Else
    sheet4.Range("A6").Resize(i, 3) = Temp
End If
End Sub
 
 
  SHEET1 ‫‬.xlsm   تحميل xlsm مرات التحميل :(2)
الحجم :(17.971) KB


19-06-2020 07:34 مساء
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تعديل كود جلب اسماء الشيتات وعناوين الخلايا
جرب هذا الكود

Option Explicit
Sub Test()
Dim R As Worksheet, ws As Worksheet
Dim k%
Dim Fnd As Range
k = 6
Set R = Sheets("result")
    If R.Range("A5").CurrentRegion.Rows.Count > 1 Then
       R.Range("A5").CurrentRegion.Offset(1). _
       Resize(R.Range("A5").CurrentRegion. _
       Rows.Count - 1).ClearContents
    End If
    
    If R.Range("A2") = vbNullString Then
    MsgBox "Type in cell A2 a value to find it"
    Exit Sub
    End If
For Each ws In ThisWorkbook.Sheets
If Not ws.Name = R.Name Then
   With ws
    Set Fnd = .UsedRange.Find(R.Range("A2"), lookat:=1)
       If Not Fnd Is Nothing Then
            With R.Cells(k, 1)
                .Value = ws.Name
                .Offset(, 1) = Fnd.Address
                .Offset(, 2) = Fnd
               k = k + 1
             End With
        End If
   End With
End If
Next ws
If k = 6 Then MsgBox "I Can't Find  " & _
 """" & R.Range("A2") & """" & "  Any Where"
End Sub


الملف مرفق
 
 
  Moubtadaa.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(29.232) KB


19-06-2020 07:43 مساء
مشاهدة مشاركة منفردة [2]
المبتدأ
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 299
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 2
قوة السمعة : 244
 offline 
look/images/icons/i1.gif تعديل كود جلب اسماء الشيتات وعناوين الخلايا
شكرا   استاد  سليم    لو  امكن  اضافة    رسالة  تحذير       بمعنى  لو  كتبت  احرف  صغيرة   يظهر  لي  رسالة  تحذيرية   بعدم  وجود  هذا   الصنف   اي  البحث   خاص  بالاحرف  الكبيرة فقط

19-06-2020 09:36 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif تعديل كود جلب اسماء الشيتات وعناوين الخلايا
أخي الكريم 
هل أصبح التعديل على الأكواد أو المحاولة مستحيل حتى لا تتمكن من وضع رسالة ...؟!! أعتقد لابد من معرفة الأساسيات بشكل جيد .. فالمنتدى تعليمي وليس خدمي

19-06-2020 10:32 مساء
مشاهدة مشاركة منفردة [4]
المبتدأ
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 299
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 2
قوة السمعة : 244
 offline 
look/images/icons/i1.gif تعديل كود جلب اسماء الشيتات وعناوين الخلايا
استاد  ياسر  اشكرك  على  المرور   ولكن  لو  ان  الشخص  غير  متخصص  بالبرمجة  ماذا  يفعل     ثم  ان جل  المواقع   عندما   يعطيك   كود     ليس  مستعد  صاحب  الكود  ان يشرح ه لك  سطر سطر  حتى  موقعكم  الكريم   بالكاد  يجيب  بشكل   عام    ولا  يتناول بعض   الخصائص   التي  يصعب  على  غير  المبرمج  فهمها   

19-06-2020 10:38 مساء
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif تعديل كود جلب اسماء الشيتات وعناوين الخلايا
أخي الكريم 
المنتدى مليء بالموضوعات والشروحات ، يبدو أنك لم تتصفح الموقع بشكل جيد
والحلول التي تقدم بالكاد ، ستجد أفضل منها في مواقع أخرى ، وخصوصاً المواقع الأجنبية .. 
وفقك الله

20-06-2020 08:12 صباحا
مشاهدة مشاركة منفردة [6]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تعديل كود جلب اسماء الشيتات وعناوين الخلايا
تم التعديل على الكود ( Case Sinsitive )
ليتناسب مه ما تريد
بالاضافة الى أنه  اذا ظهر ما نبحث عنه أكثر من مرة في نفس الشيت يتم ادراجه ايضاً
 
 
 
  Moubtadaa-1.xlsm   تحميل xlsm مرات التحميل :(6)
الحجم :(33.271) KB





الكلمات الدلالية
الخلايا ، وعناوين ، الشيتات ، اسماء ، تعديل ،


 










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

الساعة الآن 10:21 صباحا