اذهب الي المحتوي
أوفيسنا

تعديل كود استدعاء بيانات


الردود الموصى بها

السلام عليكم ورحمة الله وبركاته

تعديل كود استدعاء البيانات المطلوبه بناء علي الشروط المحدده في الخلايه الملونه باللون الاخضر كما موضح مع مراعة الصفوف المظلله باللون الاخضر اسفل كل صفحة وعدم وضع اي بيانات بها او مسحها حيث انها هذه الصفوف يوجد بها معادلات لجمع القيم الموجوده بالورقة وفي حالة وجود بيانات لاكثر من ورقة يتم وضع البيانات بدايه من الصفحة التاليه وهكذا

مرفق ملف للاطلاع

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

استدعاء بيانات.rar

 

رابط هذا التعليق
شارك

ممكن حد يعرفني شرح للكود دا 

عايز اضيف نطاق مختلف من حيث عدد الاعمدة في شيت استدعاء البيانات

 

 

Sub Macro1()
Dim iNm As String
Dim Lr As Long, i As Long
Dim R As Integer
Dim d1 As Double, d2 As Double
' ========================================================
' äØÇÞ ÇÓÊÏÚÇÁ ÇáÈíÇäÇÊ

iNm = Range("B1").Value ' ÇÓã äæÚ ÇáÈÍË

d1 = Range("B2").Value2 ' ÈÏÇíÉ ÊÇÑíÎ ÇáÝÊÑÉ  ááÈÍË

d2 = Range("B3").Value2 ' äåÇíÉ ÊÇÑíÎ ÇáÝÊÑÉ ááÈÍË
' ========================================================

' ÈÏÇíÉ ÕÝ ÕÝÍÉ ÇáßÔÝ

هنا محتاج تحديد النطاق لاستدعاء البيانات من ( A6:S1000  )

 

Range("D6:K35").ClearContents
''''''''''''''''
Application.ScreenUpdating = False

' ãÕÏÑ ÇáÈíÇäÇÊ

بالنسبة للشيت دا محتاج نقل كل البيانات الموجودة في النطاق

من ( A6:S1000  )

With sheet1
  ' ÚãæÏ ÇáÈÍË
    Lr = .Cells(.Rows.Count, "C").End(xlUp).Row
    ' ÈÏÇíÉ ÕÝ ÇáÈíÇäÇÊ
    For i = 6 To Lr
    ' ßáãÉ ÇáÈÍË æÇáÚãæÏ ÇáÈÍË
        If iNm = CStr(.Cells(i, "C")) Or iNm = CStr(.Cells(i, "D")) Then
        ' ÊÇÑíÎ
            Select Case .Cells(i, "F").Value2
                Case d1 To d2
                R = R + 1
                ' ÚãæÏ ÇáÏÇÆä
                Cells(R + 5, "D").Value = R
                ' ÚãæÏ ÇáÊÇÑíÎ
                Cells(R + 5, "F").Resize(1, 4).Value = .Cells(i, "F").Resize(1, 4).Value
                If iNm = CStr(.Cells(i, "C")) Then
                ' ÇáÌÇäÈ ÇáÏÇÆä
                    Cells(R + 5, "J").Value = .Cells(i, "J").Value
                Else
                ' ÇáãÈáÛ ÇáÏÇÆä
                    Cells(R + 5, "K").Value = .Cells(i, "K").Value
                End If
            End Select
        End If
    Next
End With
Application.ScreenUpdating = True
End Sub

رابط هذا التعليق
شارك

ياتري ايه سبب ان مافيش حد بيرد عليا نهائيا ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

هو الموضوع صعب تنفيذه ولا عدم وجود وقت عند اساتذة المنتدي الافاضل ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

تم تعديل بواسطه ابو حمادة
رابط هذا التعليق
شارك

عليكم السلام ورحمة الله تعالي وبركاته

اخيرا لقيت حد هنا

 

الحمد لله ان فيه ناس موجودة هههههههههه

يبقا الطلب بتاعي صعب تنفيذه تقريبا

 

رابط هذا التعليق
شارك

ياريت والله محتاج الملف دا ضرورى جدا

كنت عايز اعرف من حضرتك العت علي الملف

؟؟؟؟؟؟؟؟؟؟؟؟

ويريت اعرف ايه الاصعب فيه لو كدا ممكن نستبعد الحاجه الصعبه فيه

 

رابط هذا التعليق
شارك

صدقنى حاولت فيه من ساعة اخر مشاركة مع حضرتك

لان انا فى الاصل مبرمج اكسس وخبرتى حوالى 60% فى الاكسل

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

 

  • Like 1
رابط هذا التعليق
شارك

شكرا لاهتمامك استاذي الغالي 

انا عايز اعمل برنامج خاص بمكتبه لبيع الادوات المدرسية

ومعنديش خبره كتيره

 

تم تعديل بواسطه ابو حمادة
  • Like 1
رابط هذا التعليق
شارك

هيكون عن حضرتك اليوم اعطينى اسم المكتبة لاضع الاسم فى المقدمة الشاشة الافتتاحية والتقارير

اعطينى اميلك لارسل لحضرتك البرنامج وطريق التشغيل

تم تعديل بواسطه بحار الاكسس
رابط هذا التعليق
شارك

بالنسبة للاميل

basmtaml252@yahoo.com

بس فيه ملحوظه مهمه

محتاج فيها تخصصات معينه يعني يكون ليها باص ورد لاكتر من يوزر بعض اليوزارات مش يكون ليها كل الصلاحيات

 

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information