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

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


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


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





بطاقة الصنف و اكواد خاص بها

السلام عليكم و رحمة الله و بركاتة اولاquot; اشكر القائمين على ادارة هذا المنتدى و اسال الله ان يجعل الاعمال التى يقومون ..



17-12-2019 09:09 مساء
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 92
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
قوة السمعة : 111
الاعجاب : 1
 offline 
السلام عليكم و رحمة الله و بركاتة

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


Private Sub Worksheet_Change(ByVal Target As Range)
    If  target . Address "$C$8" then
    For I = 2 To 1000
    x = WorksheetFunction.CountA(Range("b12:b1000"))
    if sheets(ÊÞÑíÑ ÇáÃÕäÇÝ).cells(i,4) = (c8) . Vaiue then
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, o) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 8)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 1) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 9)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 3) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 11)
    
    End If
    Next I
     For I = 2 To 1000
     x = WorksheetFunction.CountA(Range("b10:b1000"))
     if sheets(10).cells(i,10) = (c8) . Vaiue then
     
     Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, o) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 8)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 1) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 9)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 3) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 11)
      End If
       Next I
       Range("b10:b1000").Sort key1: Range ("ab5"), order1: xlAscending
       ordercustom : = 1
              
End Sub

       
    و جزاكم الله خير
      
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

 
 
 
  Book2.zip   تحميل zip مرات التحميل :(12)
الحجم :(1194.863) KB





17-12-2019 09:28 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 21
قوة السمعة : 25478
الاعجاب : 177
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
وعليكم السلام
ما هي المشكلة بالضبط ..؟ لابد من توضيح كافة التفاصيل المرتبطة بالموضوع أخي مسطاح




21-12-2019 09:20 صباحا
مشاهدة مشاركة منفردة [2]
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 92
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
قوة السمعة : 111
الاعجاب : 1
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
استاذ ياسر اطال الله في عمرك و زادك علما 
ارغب بنسخ البيانات من تقرير الوارد و التقرير الصرف اتوماتيكيا" الى بطاقة الصنف عن طريق بحث بالرقم الصنف  c8(في بطاقة الصنف)
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

Private Sub Worksheet_Change(ByVal Target As Range)




    If  target . Address "$C$8" then
    For I = 2 To 1000
    x = WorksheetFunction.CountA(Range("b12:b1000"))
    if sheets("ÊÞÑíÑÇáæÇÑÏ").cells(i,4) = (c8).  Vaiue then
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, o) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 8)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 1) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 9)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 3) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 11)
      if sheets("ÊÞÑíÑÇáÕÑÝ").cells(i,4) = (c8).  Vaiue then
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, o) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 8)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 1) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 9)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 3) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 11)
    
    End If
    Next I
     For I = 2 To 1000
     x = WorksheetFunction.CountA(Range("b10:b1000"))
     if sheets(10).cells(i,10) = (c8) . Vaiue then
     
     Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, o) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 8)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 1) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 9)
    Sheets(ÈØÇÞÉ ÇáÕäÝ).Cells(12, 2).Offset(x, 3) = Sheet(ÈØÇÞÉ ÇáÕäÝ).Cells(I, 11)
      End If
       Next I
       Range("b10:b1000").Sort key1: Range ("b12"), order1: xlAscending
       ordercustom : = 1
        
    End Sub

   
    
 
 
  Book2.zip   تحميل zip مرات التحميل :(2)
الحجم :(78.433) KB





21-12-2019 11:22 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 21
قوة السمعة : 25478
الاعجاب : 177
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
يفضل أن يكون كل طلب في موضوع مستقل لكي لا تتداخل الموضوع أخي مسطاح
اطرح موضوع جديد وضع ملف مرفق وشكل المعطيات وضع شكل النتائج المتوقعة ليسهل فهم المطلوب ..




21-12-2019 11:39 صباحا
مشاهدة مشاركة منفردة [4]
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 92
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
قوة السمعة : 111
الاعجاب : 1
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها

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


لك التكريم يا قمر المعالي فيك تجمعت زين الخصال بعلمك قد علوت اليوم قدراً، فقدرك بين كل الناس عالي، فعذراً يا ربة الأجيال عذراً بحقك لن يفي اليوم كلامي.

 




21-12-2019 11:41 صباحا
مشاهدة مشاركة منفردة [5]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 21
قوة السمعة : 25478
الاعجاب : 177
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
أخي الكريم مسطاح
بارك الله فيك على كلماتك الطيبة

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




21-12-2019 11:57 صباحا
مشاهدة مشاركة منفردة [6]
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 92
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
قوة السمعة : 111
الاعجاب : 1
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
عند دخول الى بطاقة الصنف و اختيار رقم الصنف من c8  و ذهاب الى ايقونة البحث (يبحث في ملف تقريرالوارد ليضعها في b12.c12.d12 e12 و يبحث في ملف تقريرالصرف ليضعها في h12.c12.G12 f12 )اما الرصيد =IF(F9>0;I11+D12-G12;"")  و الرصيد  البداية I11 يبحث في ملف (بيانات الاصناف ) من F9 الى F1000

ما أجمل العيش بين أناس احتضنوا العلم

 




21-12-2019 12:35 مساء
مشاهدة مشاركة منفردة [7]
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 92
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
قوة السمعة : 111
الاعجاب : 1
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها




21-12-2019 12:50 مساء
مشاهدة مشاركة منفردة [8]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 21
قوة السمعة : 25478
الاعجاب : 177
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
التاريخ بيكون من ورقة الوارد ولا الصادر ..لأنك ذكرت الخلية C12 مرتين ...!!؟
ممكن صورة لشكل النتائج المتوقعة لرقم صنف معين (لاحظ أنني طلبت شكل النتائج المتوقعة أكثر من مرة ، وهذه آخر مرة أطلب فيها هذا الأمر)




21-12-2019 01:02 مساء
مشاهدة مشاركة منفردة [9]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 21
قوة السمعة : 25478
الاعجاب : 177
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
جرب الكود التالي عله يفي بالغرض إن شاء الله 
قم بإزالة أي خلايا مدمجة قبل تنفيذ الكود
Sub Test()
    Dim x, y, wsWared As Worksheet, wsSarf As Worksheet, sh As Worksheet, lr As Long
    
    Application.ScreenUpdating = False
        Set wsWared = ThisWorkbook.Worksheets("تقريرالوارد")
        Set wsSarf = ThisWorkbook.Worksheets("تقريرالصرف")
        Set sh = ThisWorkbook.Worksheets("بطاقة الصنف")
        lr = sh.Cells(Rows.Count, 3).End(xlUp).Row + 1
        
        If sh.Range("C8").Value = "" Then Exit Sub
        
        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




21-12-2019 11:50 مساء
مشاهدة مشاركة منفردة [10]
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 92
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
قوة السمعة : 111
الاعجاب : 1
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
لن أنسى مافعلته من أجلي .. لكِ مني كل الحب والاحترام والتقدير
ارفق لك ملف التوضيح و ارجوا ان يكون هذا المطلوب
بداية السنة مالية يعني بداية تشغيل البرنامج مثلا"اذا  بدا البرنامج عام 2020 يكتب 1-1-2020 و اذا بداء البرنامج عام2021 يكتب 1-1-2021 لا يهم في اي شهر المهم بداية العام التى يبداء البرنامج
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  Book2.zip   تحميل zip مرات التحميل :(4)
الحجم :(104.614) KB





22-12-2019 06:15 صباحا
مشاهدة مشاركة منفردة [11]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8650
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 21
قوة السمعة : 25478
الاعجاب : 177
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
أخي الكريم مسطاح
في الحقيقة أنا لا أحب أن يكون طرح الموضوعات بهذا الشكل
حيث أن الطلب يتغير ويزيد في كل مشاركة ، لذا الرجاء الالتزام بقواعد المشاركة وأن يكون الموضوع لطلب واحد فقط ويكون هناك مرفق وواضح كل التفاصيل من أول مشاركة .. كما يرجى أن يكون الطلب واحد فقط في الموضوع 
عموماً إليك التعديل التالي (والأخير بالنسبة لي حيث أن وقتي لا يتسع للموضوعات المطولة في الوقت الحالي) ..
إذا كانت هناك أي ملاحظة في الكود يرجى مناقشة نتائج الكود وليس توضيح الأمر من البداية .. ابدأ من حيث انتهى الكود من نتائج
أرجو أن يفي الكود بالغرض إن شاء الله
Sub Test()
    Dim v, x, y, wsItems As Worksheet, wsWared As Worksheet, wsSarf As Worksheet, sh As Worksheet, lr As Long
    
    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




22-12-2019 01:19 مساء
مشاهدة مشاركة منفردة [12]
mostah
menu_open
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-07-2019
رقم العضوية : 13735
المشاركات : 92
الجنس : ذكر
تاريخ الميلاد : 1-1-1966
قوة السمعة : 111
الاعجاب : 1
 offline 
look/images/icons/i1.gif بطاقة الصنف و اكواد خاص بها
استاذ ياسر
أريد أن أكون أول المهنئين لك... بهذا التميز(المدير المتميز) و يسعدني في هذه المناسبه السعيده ان اقدم لك اجمل التهاني والتبريكات. فالف مبروك لك .. شكرا" على جهودك الطيبه وان شاء الله من تقدم لتقدم وتحياتي لكافة العاملين في هذه المنتدى الرائده من ادراه والاعضاء وفقكم الله


استاذ ياسر
لحتى الان لم انجح في الحصول على نتائج تحتوي على جميع عبارات البحث التي أدخلتها.






المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
برنامح مخازن 2018 مجانا اول برنامج به كارت الصنف علي الفورم رمضان بكري
59 7816 خالد سونا
بطاقة الصنف للمستودع mostah
19 506 mostah
برنامج المخازن وفاتورة البيع وعربيات البيع ومناديب كارت الصنف رمضان بكري
2 583 medo_ali918
البحث عن سعر بيع الصنف بأكثر من طريقة vba عبدالرحمن صبحى
3 323 عبدالرحمن صبحى
سعر الصنف حسب شريحة كل عميل Yasser Elaraby
39 3949 عبدالله فتحى

الكلمات الدلالية
بطاقة ، الصنف ، اكواد ،


 







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

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

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