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

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


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





كود الترحيل حسب قيم مختلفة

السلام عليكم و رحمة الله و بركاته عندي ملف اكسل اريد ترحيل البيانات عن طريق كود VBA من الورقة quot;BDquot; الى الورقة q ..


موضوع مغلق

الصفحة 1 من 2 < 1 2 > الأخيرة »


06-03-2021 06:45 مساء
noureddine70
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2019
رقم العضوية : 11894
المشاركات : 73
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 6-12-1970
يتابعهم : 7
يتابعونه : 0
قوة السمعة : 103
 offline 

السلام عليكم و رحمة الله و بركاته
عندي ملف اكسل اريد ترحيل البيانات عن طريق  كود VBA من الورقة "BD" الى الورقة "CV" حسب الإسم و عموديا القيم v1-v10  و حسب القيم A-B-C-D كما هو موضح في الجدول في الورقة "CV"

و بارك الله فيكم و جزاكم الله خيرا

Relay code

 
 
  الترحيل حسب القيم.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(17.767) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
رغم أن المنطق غير واضح بناءً على أول مشاركة .. جرب التعديل التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Dim x, ws As Worksheet, sh As Worksheet, sGrade As String, iMark As Integer, m As Long, r As Long, c As Long, cl As Long
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("BD")
    Set sh = ThisWorkbook.Worksheets("CV")
    m = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For r = 3 To m
        x = Application.Match(ws.Cells(r, 1).Value, sh.Columns(1), 0)
        If IsError(x) Then GoTo Skipper
        sh.Range("C" & x + 1).Resize(10, 5).ClearContents
        For c = 2 To 11
            sGrade = ws.Cells(r, c).Value
            Select Case sGrade
                Case "A": iMark = 8: cl = 3
                Case "B": iMark = 7: cl = 4
                Case "C": iMark = 4: cl = 5
                Case "D": iMark = 1: cl = 6
                Case Else: GoTo nextV
            End Select
            sh.Cells(x + c - 1, cl).Value = iMark
            If sGrade = "A" Then sh.Cells(x + c - 1, 7).Value = 1
nextV:
        Next c
Skipper:
    Next r
    Application.ScreenUpdating = True
    MsgBox "Done", 64, "YasserKhalil Excel-Egy"
End Sub
عرض الإجابة




06-03-2021 07:45 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
وعليكم السلام
يرجى عدم تغيير حجم الخط ، اكتب المشاركة بالشكل الطبيعي بحيث يكون السؤال واضح
جرب الكود التالي عله يفي بالغرض (قم بدراسة الكود بشكل جيد واسأل في الجزئيات بحيث تتمكن من التعديل على الكود بنفسك وتتعلم وتستفيد وتفيد الآخرين)
Sub Test()
    Dim x, ws As Worksheet, sh As Worksheet, sGrade As String, iMark As Integer, m As Long, r As Long, c As Long, cl As Long
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("BD")
    Set sh = ThisWorkbook.Worksheets("CV")
    m = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For r = 3 To m
        x = Application.Match(ws.Cells(r, 1).Value, sh.Columns(1), 0)
        If IsError(x) Then GoTo Skipper
        sh.Range("C" & x + 1).Resize(10, 4).ClearContents
        For c = 2 To 11
            sGrade = ws.Cells(r, c).Value
            Select Case sGrade
                Case "A": iMark = 8: cl = 3
                Case "B": iMark = 7: cl = 4
                Case "C": iMark = 4: cl = 5
                Case "D": iMark = 1: cl = 6
                Case Else: GoTo nextV
            End Select
            sh.Cells(x + c - 1, cl).Value = iMark
nextV:
        Next c
Skipper:
    Next r
    Application.ScreenUpdating = True
    MsgBox "Done", 64, "YasserKhalil Excel-Egy"
End Sub

06-03-2021 08:30 مساء
مشاهدة مشاركة منفردة [2]
noureddine70
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2019
رقم العضوية : 11894
المشاركات : 73
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 6-12-1970
يتابعهم : 7
يتابعونه : 0
قوة السمعة : 103
 offline 
look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
جزاكم الله خيرا و بارك الله فيكم الكود 100/100
 

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

07-03-2021 12:03 صباحا
مشاهدة مشاركة منفردة [4]
noureddine70
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2019
رقم العضوية : 11894
المشاركات : 73
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 6-12-1970
يتابعهم : 7
يتابعونه : 0
قوة السمعة : 103
 offline 
look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
بارك الله فيكم و جزاكم الله خيرا
لقد ظهرت لي مشكلة اخرى و هي 
اذا اردت أن أعطي قيمة لمثلا "A" و لكن لعمود أخر مثلا
   Case "A": iMark = 2: cl = 4
أو اي عمود أخر مثلا العمود 7

كيف استطيع اضافة هذا السطر مع الكوذ الي عملته انت
و جزاكم الله خيرا
هذا قطعة من الكود تاعك
               
Case "A": iMark = 8: cl = 3
                Case "B": iMark = 7: cl = 4
                Case "C": iMark = 4: cl = 5
                Case "D": iMark = 1: cl = 6

              
 
Case "A": iMark = 8: cl = 3                 Case "B": iMark = 7: cl = 4                 Case "C": iMark = 4: cl = 5                 Case "D": iMark = 1: cl = 6
 

07-03-2021 07:10 صباحا
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
في هذا السطر على سبيل المثال
Case "A": iMark = 8


التقدير المستخدم هو A والدرجة المقابلة لهذا التقددير هي 8 ويتم تحديد العمود المراد وضع الدرجة فيه بناءً على قيمة المتغير المسمى cl بمعنى لو أردت وضع الدرجة في العمود الرابع في الورقة الهدف فقم بتعيين القيمة 4 للمتغير المسمى cl إلى 4

07-03-2021 07:11 مساء
مشاهدة مشاركة منفردة [6]
noureddine70
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2019
رقم العضوية : 11894
المشاركات : 73
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 6-12-1970
يتابعهم : 7
يتابعونه : 0
قوة السمعة : 103
 offline 
look/images/icons/upload/awt9.gif كود الترحيل حسب قيم مختلفة
بارك الله فيك و جزاك الله خيرا
انا اردت ان اطرح السؤال كالتالي 
هل ممكن ان تاخذ A قيمتين ولكن بشرط if
مثلا اذا كانت قيمة الخلية هي A فستكون قيمتها  8 في العمود 3 و قيمتها 1 في العمود 7
Case "A": iMark = 8: cl = 3 Case "A": iMark = 1: cl=7

و جزاكم الله خيرا
 
Case "A": iMark = 8: cl = 3 Case "A": iMark = 1: cl=7
 


الصفحة 1 من 2 < 1 2 > الأخيرة »


الكلمات الدلالية
الترحيل ،


 










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

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