اذهب الي المحتوي
أوفيسنا

استدعاء بيانات من اعمدة متفرقة الى الورقة الهدف


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

السلام عليكم

الاساتذة الكرام وفقكم الله

وجدت في المنتدى كودين للترحيل و الاستدعاء  ومن اعمدة متفرقة  وحاولت تنفيذه على ملفي فتعطي النتيجة خطا علما غيرت المعطيات كما في الشرح

ارجو التفضل باجراء تعديل على كود الاستدعاء وتجنب الخطا الصادر اثناء تنفيذ الكود

واذا كان هناك كود جديد يفي بالغرض فجزاكم الله خيرا

لكم وافر احترامي

استدعاء اعمدة متفرقة الى الورقة .xlsm

رابط هذا التعليق
شارك

هذا الماكرو يقوم بما تريد

Option Explicit
Option Base 1
 Sub My_code()
    Dim m%, k%, lr%, i%
    Dim Main As Worksheet, sh As Worksheet
    Dim myArray, arr(11), targt$
    
    Set Main = Sheets("Allstudents")
    Set sh = Sheets("from.school")
    sh.Range("B7:M1000").Clear
    
    targt = "from*"
    lr = Main.Cells(Rows.Count, "D").End(xlUp).Row
    m = 7
    For i = 3 To 13
     arr(i - 2) = i
    Next
    
    myArray = Array(38, 4, 5, 27, 13, 16, 18, 19, 20, 21, 22)
For i = 5 To lr
      If Main.Cells(i, "AD") Like "*" & targt Then
        For k = 1 To 11
         sh.Cells(m, arr(k)) = Main.Cells(i, myArray(k))
       Next
       m = m + 1
    End If
Next

With sh.Range("B7").Resize(m - 7, 13)
    .Borders.LineStyle = 1
    .HorizontalAlignment = 1
    .InsertIndent 1
        With .Font
          .Bold = True
          .Size = 14
        End With
End With
End Sub

الملف مرفق

My_data .xlsm

  • Like 2
رابط هذا التعليق
شارك

شكرا لكم على سرعة الاجابة وفقكم الله

ودائما مبدع استاذ سليم

عند تنفيذ الكود ظهر خطا لا في السطر الاصفر

لكم وافر احترامي وتقديري

2146009379_.png.24064ed694a9e636400172598b2e2ecf.png

 

تم تعديل بواسطه مصطفى محمود مصطفى
  • Like 1
رابط هذا التعليق
شارك

نسال الله سبحانه وتعالى ان يوفقكم ويحفظكم استاذ سليم

الكود يعمل  الان بعد التعديل بشكل ممتاز ورائع

تقبلوا وافر احترامي وتقديري

السلام عليكم استاذ سليم

عند ترحيل التاريخ يظهر على شكل رقم ونسقت الخلايا التي يرحل لها التاريخ نسقتها تاريخ

لكن عند تنفيذ الكود كذلك ترجع ارقام

هل ممكن حل للمشكلة

جزاكم الله خيرا

رابط هذا التعليق
شارك

أضف هذا العبارة في نهاية الكود  قبل  End With  الأخيرة

.Value = .Value

لتصبح نهاية الكود هكذا

With sh.Range("B7").Resize(m - 7, 13)
    .Borders.LineStyle = 1
    .HorizontalAlignment = 1
    .InsertIndent 1
        With .Font
          .Bold = True
          .Size = 14
        End With
     .Value = .Value
End With

End Sub

 

  • Like 1
رابط هذا التعليق
شارك

الاخ سليم جزاكم الله خيرا

الخطا لازال والتاريخ لم ينسق بعد اضافة التعديل

علما وضعت التعديل قبل الاخيره

With sh.Range("b7").Resize(m - 7, 12)
    .Borders.LineStyle = 1
    .HorizontalAlignment = 1
    .InsertIndent 1
        With .Font
          .Bold = True
          .Size = 14
           
        End With
        .Value = .Value
End With
End Sub

ولم يتم تعديل التاريخ لكن رسالة الخطأ اختفت

تحياتي لكم

 

خطا التاريخ.png

خطا كود تعديل التاريخ.png

تم تعديل بواسطه مصطفى محمود مصطفى
رابط هذا التعليق
شارك

  • أفضل إجابة

تصحيح بسيط

With sh.Range("B7").Resize(m - 7, 13)
    .Borders.LineStyle = 1
    .HorizontalAlignment = 1
    .InsertIndent 1
        With .Font
          .Bold = True
          .Size = 14
        End With
        '++++++++++++++++++++++++++++++++++++++++++++++++++++++
        '   الرقم 10 هنا يرمز الى رقم العامود في الجدول حيث يوجد التاريخ
        'أقصد العمود K
   .Columns(10).NumberFormat = "yyyy/m/d"
        '+++++++++++++++++++++++++++++++++++++++++++++++++++++++
End With
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

بارك الله في صحتكم ورزقكم اخي سليم

جعله الله في ميزان حسناتكم وزادكم من فضله

الكود بعد التعديل  يعمل بشكل ممتاز واضفت الاعمدة الاخرى تحت بعض وعمل بشكل صحيح

والخطا في كتابة رقم العمود المطلوب من قبلي

تحياتي لكم

  • Like 1
رابط هذا التعليق
شارك

Option Explicit
Option Base 1

 Sub My_code()
    Dim m%, k%, lr%, i%
    Dim Main As Worksheet, sh As Worksheet
    Dim myArray, arr(11), targt$
    
    Set Main = Sheets("Allstudents")
    Set sh = Sheets("from.school")
    sh.Range("B7:M1000").Clear
    
    targt = "from*"
    lr = Main.Cells(Rows.Count, "D").End(xlUp).Row
    m = 7
    For i = 3 To 13
     arr(i - 2) = i
    Next
    
    myArray = Array(38, 4, 5, 27, 13, 16, 18, 19, 20, 21, 22)
For i = 5 To lr
      If Main.Cells(i, "AD") Like "*" & targt Then
        For k = 1 To 11
         sh.Cells(m, arr(k)) = Main.Cells(i, myArray(k))
       Next
       m = m + 1
    End If
Next

With sh.Range("B7").Resize(m - 7, 13)
    .Borders.LineStyle = 1
    .HorizontalAlignment = 1
    .InsertIndent 1
        With .Font
          .Bold = True
          .Size = 14
        End With
        '++++++++++++++++++++++++++++++++++++++++++++++++++++++
        '   الرقم 10 هنا يرمز الى رقم العامود في الجدول حيث يوجد التاريخ
        'أقصد العمود K
   .Columns(10).NumberFormat = "yyyy/m/d"
        '+++++++++++++++++++++++++++++++++++++++++++++++++++++++
End With
End Sub

الكود بعد كل الاضافات التي تمت بارك الله في الاستاذ سليم

وبارك الله في كل من يساعد على نشر العلم وليس اغلاقه

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم

استاذ سليم حاصبيا تحياتي لكم

ارجو تعديل او اضافة للكود حيث اذا لم يجد بيانات يقوم باستدعائها حسب الشرط المفترض  يعطي رسالة خطا

 و عند اضافة واحد او اكثر  به شرط الاستدعاء يعمل الكود بشكل صحيح هل يمكن تجاوز هذا الخطا عندما لاتكون هناك بيانات لاستدعائها بالشرط المفترض

لكم وافر احترامي

2105674516_.jpg.182d5a60206b68e0e1909d0e736c561d.jpg

رابط هذا التعليق
شارك

4 دقائق مضت, مصطفى محمود مصطفى said:

السلام عليكم

استاذ سليم حاصبيا تحياتي لكم

ارجو تعديل او اضافة للكود حيث اذا لم يجد بيانات يقوم باستدعائها حسب الشرط المفترض  يعطي رسالة خطا

 و عند اضافة واحد او اكثر  به شرط الاستدعاء يعمل الكود بشكل صحيح هل يمكن تجاوز هذا الخطا عندما لاتكون هناك بيانات لاستدعائها بالشرط المفترض

لكم وافر احترامي

2105674516_.jpg.182d5a60206b68e0e1909d0e736c561d.jpg

الملف قد مسحته من جهازي 

ارفع الملف من جديد للمعاينة

  • Like 1
رابط هذا التعليق
شارك

الاستاذ سليم حاصبيا دعواتي لكم بدوام الصحة والعافية

انتهت المشكلة واصبح الكود يتجاوز الخطا المذكور

جعله الله سبحانه وتعالى في ميزان حسناتكم

لكم وافر الاحترام والتقدير

 

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information