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



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






موضوع مغلق


  • تمت الإجابة
06-03-2021 06:45 مساءً
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2019
رقم العضوية : 11894
المشاركات : 67
الدولة : الجزائر
الجنس :
تاريخ الميلاد : 6-12-1970
قوة السمعة : 110
الاعجاب : 2

السلام عليكم و رحمة الله و بركاته
عندي ملف اكسل اريد ترحيل البيانات عن طريق كود VBA من الورقة "BD" الى الورقة "CV" حسب الإسم و عموديا القيم v1-v10 و حسب القيم A-B-C-D كما هو موضح في الجدول في الورقة "CV"
[face=arial, helvetica, sans-serif]و بارك الله فيكم و جزاكم الله خيرا[/face]


Relay code

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





look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
  06-03-2021 07:45 مساءً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10516
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36718
الاعجاب : 170
وعليكم السلام
يرجى عدم تغيير حجم الخط ، اكتب المشاركة بالشكل الطبيعي بحيث يكون السؤال واضح
جرب الكود التالي عله يفي بالغرض (قم بدراسة الكود بشكل جيد واسأل في الجزئيات بحيث تتمكن من التعديل على الكود بنفسك وتتعلم وتستفيد وتفيد الآخرين)
CODE
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

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



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

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



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

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



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

كيف استطيع اضافة هذا السطر مع الكوذ الي عملته انت
و جزاكم الله خيرا
هذا قطعة من الكود تاعك
CODE
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




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


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

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



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

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


Case "A": iMark = 8: cl = 3 Case "A": iMark = 1: cl=7




look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
  07-03-2021 07:28 مساءً   [7]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10516
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36718
الاعجاب : 170
النقطة الأخيرة غير واضحة .. حاول توضحها بصورة
ويمكنك استخدام جملة If داخل جملة Select إذا كان هناك تفريعات وشروط أخرى.

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



look/images/icons/upload/awt9.gif كود الترحيل حسب قيم مختلفة
  07-03-2021 10:43 مساءً   [8]
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2019
رقم العضوية : 11894
المشاركات : 67
الدولة : الجزائر
الجنس :
تاريخ الميلاد : 6-12-1970
قوة السمعة : 110
الاعجاب : 2
السلام عليكم و رحمة الله و بركاته
اسمحلي الأستاذ ياسر اتعبتك معي
اريد بارك الله ان أجعل لـ "A" قيمتين الأولى 8 و يضعها في cl=3 و الثانية 1 و يضعها في cl=7

Case "A": iMark = 8: cl = 3
Case "A": iMark = 1: cl = 7
لا أعلم كيف أدخل if الشرطية على select case
أنا قصدي كما نفعل مع if then
و التوضيح في الملف المرفوع
 
 
  الترحيل حسب القيم معدل.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(21.485) KB





look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
  08-03-2021 06:50 صباحاً   [9]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10516
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36718
الاعجاب : 170
رغم أن المنطق غير واضح بناءً على أول مشاركة .. جرب التعديل التالي عله يفي بالغرض إن شاء الله
CODE
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

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



look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
  08-03-2021 03:40 مساءً   [10]
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2019
رقم العضوية : 11894
المشاركات : 67
الدولة : الجزائر
الجنس :
تاريخ الميلاد : 6-12-1970
قوة السمعة : 110
الاعجاب : 2
بارك الله فيك و جزاك الله خيرا هذا هو المطلوب حفظك الله و رعاك وكل الاساتذة لست ادري كيف اوفي حقكم الا ان اقول جعلها الله لكم في ميزان حسناتكم و ادخلكم جنته و كل المسلمين

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



look/images/icons/i1.gif كود الترحيل حسب قيم مختلفة
  08-03-2021 03:43 مساءً   [11]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10516
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36718
الاعجاب : 170
وجزيت خيراً أخي الكريم بمثل ما دعوت لنا وزيادة والحمد لله أن تم المطلوب على خير.

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





المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
طلب تعديل في ترحيل بيانات بشروط خاصة في الترحيل بكار للأبد
0 2 بكار للأبد
تعديل كود الفلترة و الترحيل ayoub2007
0 222 ayoub2007
الترحيل لجدول به اعمدة متفرقة باستخدام For...Next أباالحسن
3 681 YasserKhalil
اصلاح كود الترحيل من عدة صفحات الى صفحة واحدة هانى على
10 2994 hassona229
الدليل الشامل في أكواد الترحيل باستخدام المصفوفات (الترحيل من ورقة عمل لورقة عمل أخرى بشرط) saad mohamed
16 1831 YasserKhalil

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








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

الساعة الآن 03:58 PM.