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

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


اعلان هنا
ألعاب فلاش أون لاين
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا


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





تعديل الكود

اخواني حاولت حل امشكلة الكود خاص ببطاقة الصنف و لكن مع الاسف الشديد لم اصل الى الحل النهائي مع العلم بان البطاقة تعمل ..



09-01-2020 10:38 مساء
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 74
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
يتابعهم : 11
يتابعونه : 0
قوة السمعة : 80
الاعجاب : 27
 offline 
 اخواني  حاولت حل امشكلة الكود خاص ببطاقة الصنف و لكن مع الاسف الشديد لم اصل الى الحل النهائي  مع العلم بان البطاقة تعمل بصورة ممتازة جدا" من جميع النواحي ما عدا مشكلة بسيطة جدا" الى وهو
عند ادخال البحث عن الصنف ياتي بالوارد و المصروف جميع الاصناف و المطلوب هو صنف واحد فقط (يعني عندما ابحث عن مصروف شاي ياتيني بالوارد و المصروف الشاي فقط     
 
عند بحث في خلية في خلية c8 ياتي فقط بالمطلوب فقط ليس جميع الوارد و الصرف مثلا" في خلية c8 كتبنا 1 و هو رقم الصنف خاص بالشاي ياتي فقط بالوارد و الصرف شاي فقط
و اذا كتبنا في خلية c8 كتبنا 2 و هو رقم الصنف خاص بالسكر ياتي فقط بالوارد و الصرف سكر فقط
و اذا كتبنا في خلية c8 كتبنا 3 و هو رقم الصنف خاص بالحليب ابو قوس ياتي فقط بالوارد و الصرف حليب ابوقوس فقط

Private Sub CommandButton1_Click()
    Dim v, x, y, wsItems As Worksheet, wsWared As Worksheet, wsSarf As Worksheet, sh As Worksheet, lr As Long
    lr = [c10000].End(xlUp).Row
Sheets("E?C?E C????").Range("b12:i10000").ClearContents
Application.ScreenUpdating = False
            Set wsItems = ThisWorkbook.Worksheets("بيانات الاصناف")
        Set wsWared = ThisWorkbook.Worksheets("تقرير الوارد")
        Set wsSarf = ThisWorkbook.Worksheets("تقرير الصرف")
        Set sh = ThisWorkbook.Worksheets("بطاقة الصنف")
        lr = Application.Max(12, sh.Cells(Rows.Count, 3).End(xlUp).Row + 1)
                If sh.Range("C8").Value = "" Then Exit Sub
                v = Application.Match(sh.Range("C8").Value, wsItems.Columns(2), 0)
        If Not IsError(v) Then
            sh.Cells(8, 3).Resize(1, 4).Value = wsItems.Cells(v, 2).Resize(1, 4).Value
            sh.Range("I11").Value = wsItems.Cells(v, 6).Value
            sh.Range("B11").Value = DateSerial(Year(Date), 1, 1)
        End If
                x = Application.Match(sh.Range("C8").Value, wsWared.Columns(1), 0)
        If Not IsError(x) Then
            sh.Cells(lr, 2).Resize(1, 2).Value = wsWared.Cells(x, 2).Resize(1, 2).Value
            sh.Cells(lr, 4).Resize(1, 2).Value = wsWared.Cells(x, 8).Resize(1, 2).Value
                    End If
                y = Application.Match(sh.Range("C8").Value, wsSarf.Columns(1), 0)
        If Not IsError(y) Then
            sh.Cells(lr, 6).Value = wsSarf.Cells(y, 3).Value
            sh.Cells(lr, 7).Resize(1, 2).Value = wsSarf.Cells(y, 8).Resize(1, 2).Value
         
        End If
       Application.ScreenUpdating = True
          
End Sub



لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  Book1.zip   تحميل zip مرات التحميل :(3)
الحجم :(190.022) KB





10-01-2020 06:50 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8422
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 440
قوة السمعة : 24564
الاعجاب : 2765
 offline 
look/images/icons/i1.gif تعديل الكود
السلام عليكم
أولاً يرجى تعديل العنوان ليكون معبر عن الموضوع بشكل أفضل
ثانياً الملف المرفق لا يوجد به أية أكواد ولا يوجد تفاصيل كافية عن المشكلة لذا حاول وضع صور بشكل المتوقع
ثالثاً عند وضع كود في الموضوع يرجى مراعاة أن يكون اتجاه الكتابة باللغة العربية لكي يتم نسخ الكلمات التي باللغة العربية بشكل صحيح
رابعاً حاول استخدام لغة الإكسيل في الشرح كأن تقول ورقة العمل كذا والعمود كذا والصف كذا والمعطيات الموجودة بالشكل كذا وأريد أن تظهر النتائج بالشكل كذا بناءً على الشروط كذا وكذا ..




10-01-2020 09:41 صباحا
مشاهدة مشاركة منفردة [2]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8422
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 440
قوة السمعة : 24564
الاعجاب : 2765
 offline 
look/images/icons/i1.gif تعديل الكود
أخي الكريم
يرجى الانتباه لكل توجيه ..
لم تقم بتغيير عنوان الموضوع ، ولم ترفق ملف به الكود نفسه ، ولم تدرج الكود بين أقواس الكود بشكل صحيح (قمت بتعديل مشاركتك لتصحيح شكل الكود) ............ !!!!
كذلك عند إرفاق ملف يراعى أن تكون البيانات في حدود 20 صف فقط لتجربة الأكواد بشكل صحيح ومعرفة ما إذا كان الكود يؤدي الغرض أم لا ..
في الحقيقة معاناة مع ملفك لعمل المطلوب عليه ، لذا الرجاء الالتزام بقواعد المشاركة وإلا لن تجد استجابة لا مني ولا من غيري

جرب الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Dim a, b, v, wsItems As Worksheet, wsWared As Worksheet, wsSarf As Worksheet, sh As Worksheet, lr As Long, i As Long, k As Long

    Application.ScreenUpdating = False
        Set wsItems = ThisWorkbook.Worksheets("بيانات الاصناف")
        Set wsWared = ThisWorkbook.Worksheets("تقريرالوارد")
        Set wsSarf = ThisWorkbook.Worksheets("تقريرالصرف")
        Set sh = ThisWorkbook.Worksheets("بطاقة الصنف")
        
        sh.Range("A12:I" & Rows.Count).ClearContents
        lr = Application.Max(12, sh.Cells(Rows.Count, 3).End(xlUp).Row + 1)
        If sh.Range("C8").Value = "" Then Exit Sub
        
        v = Application.Match(sh.Range("C8").Value, wsItems.Columns(2), 0)
        If Not IsError(v) Then
            sh.Cells(8, 3).Resize(1, 4).Value = wsItems.Cells(v, 2).Resize(1, 4).Value
            sh.Range("I11").Value = wsItems.Cells(v, 6).Value
            sh.Range("B11").Value = DateSerial(Year(Date), 1, 1)
        End If
        
        k = 0
        a = wsWared.Range("A9:I" & wsWared.Cells(Rows.Count, 3).End(xlUp).Row).Value
        ReDim b(1 To UBound(a, 1), 1 To 5)
        For i = LBound(a) To UBound(a)
            If a(i, 4) = sh.Range("C8").Value Then
                k = k + 1
                b(k, 1) = a(i, 1)
                b(k, 2) = a(i, 2)
                b(k, 3) = a(i, 3)
                b(k, 4) = a(i, 8)
                b(k, 5) = a(i, 9)
            End If
        Next i
        If k > 0 Then sh.Range("A" & lr).Resize(k, UBound(b, 2)).Value = b
        
        k = 0
        a = wsSarf.Range("A9:I" & wsSarf.Cells(Rows.Count, 3).End(xlUp).Row).Value
        ReDim b(1 To UBound(a, 1), 1 To 3)
        For i = LBound(a) To UBound(a)
            If a(i, 4) = sh.Range("C8").Value Then
                k = k + 1
                b(k, 1) = a(i, 3)
                b(k, 2) = a(i, 8)
                b(k, 3) = a(i, 9)
            End If
        Next i
        If k > 0 Then sh.Range("F" & lr).Resize(k, UBound(b, 2)).Value = b
   Application.ScreenUpdating = True
End Sub

أثارت هذه المشاركة إعجاب: ali mohamed ali، حسين مامون،



10-01-2020 10:13 صباحا
مشاهدة مشاركة منفردة [3]
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 74
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
يتابعهم : 11
يتابعونه : 0
قوة السمعة : 80
الاعجاب : 27
 offline 
look/images/icons/i1.gif تعديل الكود
استاذ ياسر
لا تسعفني كلماتي فأمدحك ولا يستيقظ عقلي من غيبته لأشكرك فمقامك محفظٌ بعلمك وقدرك محفوفٌ في صدورنا بتواضعك بوركت أيها المعلم القدير،
هذا هو المطلوب 100%

3dlat.com_02_18_9b08_a52d318330d32


 

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



10-01-2020 01:46 مساء
مشاهدة مشاركة منفردة [4]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8422
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 440
قوة السمعة : 24564
الاعجاب : 2765
 offline 
look/images/icons/i1.gif تعديل الكود
بارك الله فيك أخي الكريم مسطاح ومشكور على كلماتك الطيبة ودعائك الطيب
الحمد لله الذي بنعمته تتم الصالحات






المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
تعديل على ملف اكسيل واضافة تحصيلات ومعرفة حسابات العملاء luka
2 72 YasserKhalil
تعديل كود لايعمل a.kawkab
3 80 a.kawkab
طلب تعديل فى كود ترحيل و كود بحث mo7amed.2017
0 53 mo7amed.2017
تعديل عمل أزرار خيارات النقل والنسخ شبل
8 253 شبل
تعديل علي الملف ابو هادي
2 113 ابو هادي

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


 







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

الساعة الآن 10:57 مساء

أعلن هنا
أعلن هنا
أعلن هنا