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

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


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





مساعدة vba

مساء الخيرات محتاج كود vba يساعدنى فى تحويل داتا من جوجل فورم الى داتا بيز الورقه الاولى بها الداتا الورقه التانيه الشكل ..


موضوع مغلق


subject icon تمت الإجابة مساعدة vba
07-10-2021 02:54 مساء
omaryoseeg
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 10-09-2021
رقم العضوية : 22859
المشاركات : 3
الجنس : ذكر
تاريخ الميلاد : 0-12-1980
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 17
 offline 

مساء الخيرات محتاج كود vba يساعدنى فى تحويل داتا من جوجل فورم الى داتا بيز الورقه الاولى بها الداتا الورقه التانيه الشكل المراد عمله وانزل لكل id الدرجات الخاصه به امام اشماء المواد والسنة والترم
 
 
  نموذج بدون عنوان (الردود).xlsx   تحميل xlsx مرات التحميل :(3)
الحجم :(34.031) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
السلام عليكم
جرب الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Dim a, ws As Worksheet, sh As Worksheet, lr As Long, m As Long, n As Long, c As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("1")
        Set sh = ThisWorkbook.Worksheets("Target")
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        sh.Cells.ClearContents
        sh.Range("A1").Resize(, 7).Value = Array("A", "E", "T", "LEV", "YEAR", "ID", "GRADE")
        a = ws.Range("A3:D" & lr).Value
        n = UBound(a, 1)
        For c = 5 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
            m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
            sh.Range("A" & m).Resize(n, UBound(a, 2)).Value = a
            sh.Range("E" & m).Resize(n).Value = ws.Cells(2, c).Value
            sh.Range("F" & m).Resize(n).Value = ws.Cells(1, c).Value
            sh.Range("G" & m).Resize(n).Value = ws.Cells(3, c).Resize(n).Value
        Next c
    Application.ScreenUpdating = True
    MsgBox "Done...", 64
End Sub
عرض الإجابة




07-10-2021 04:07 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif مساعدة vba
السلام عليكم
جرب الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Dim a, ws As Worksheet, sh As Worksheet, lr As Long, m As Long, n As Long, c As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("1")
        Set sh = ThisWorkbook.Worksheets("Target")
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        sh.Cells.ClearContents
        sh.Range("A1").Resize(, 7).Value = Array("A", "E", "T", "LEV", "YEAR", "ID", "GRADE")
        a = ws.Range("A3:D" & lr).Value
        n = UBound(a, 1)
        For c = 5 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
            m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
            sh.Range("A" & m).Resize(n, UBound(a, 2)).Value = a
            sh.Range("E" & m).Resize(n).Value = ws.Cells(2, c).Value
            sh.Range("F" & m).Resize(n).Value = ws.Cells(1, c).Value
            sh.Range("G" & m).Resize(n).Value = ws.Cells(3, c).Resize(n).Value
        Next c
    Application.ScreenUpdating = True
    MsgBox "Done...", 64
End Sub

07-10-2021 04:57 مساء
مشاهدة مشاركة منفردة [2]
omaryoseeg
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 10-09-2021
رقم العضوية : 22859
المشاركات : 3
الجنس : ذكر
تاريخ الميلاد : 0-12-1980
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 17
 offline 
look/images/icons/i1.gif مساعدة vba
جزاك الله كل خير اخى الاستاذ ياسر 

07-10-2021 05:28 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif مساعدة vba
بارك الله فيك أخي الكريم
والحمد لله الذي بنعمته تتم الصالحات.



الكلمات الدلالية
مساعدة ،


 










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

الساعة الآن 08:45 صباحا