اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

مساعدة في تسريع البحث في اكسيس

naseralmaky

بواسطه naseralmaky
في قسم الأكسيس Access

 مشاركة

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

naseralmaky

naseralmaky

قام بنشر
قام بنشر

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

في البداية احب ارحب لك الاعضاء المحترمين الذي جذبني الرقي في الرد على استفسارات من له سؤال 

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

جربت اكثر من طريقة ولكن دون جدوى 
اريد حل لهذا المشكلة مع العلم مربعات البحث 8 فقط 
وهي الاسم 
الاسم الاول 
الاسم الثاني 
الاسم الثالث 
الرابع 
العائلة 
المنطقة 
المحافظة 
النوع ( ذكر او انثي) 
تم ارفاق نسخه من نموذج البحث فقط نظرا لخصوصية المعلومات وسريتها 
من يريد ان يساعد جزاه الله الف خير وبميزان حسناته 
 

0.accdbFetching info...

محمد أبوعبدالله

محمد أبوعبدالله

قام بنشر
قام بنشر

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

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

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

تحياتي

  • Like 1
naseralmaky

naseralmaky

قام بنشر
  • الكاتب
قام بنشر

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

محمد أبوعبدالله

محمد أبوعبدالله

قام بنشر
قام بنشر

السلام عليكم

اخي الكريم وضعت لك عدد 2 زر امر للبحث بطريقتين

الاثنين يعملان بكفاءة باذن الله

ولكني احتجت الى تغيير اسماء الحقول حتى استطيع احصل على نتيجة سريعة للبحث

كت انشأت الجداول الفرعية المساعدة ( المنطقة - النوع )

الكود الاول وهو يستخدم فلتر للنموذج الفرعي 

    myCriteria = myCriteria & "("
    myCriteria = myCriteria & "[tblSearch].[X1]= '" & Me.X1 & "'"
    myCriteria = myCriteria & " or "
    myCriteria = myCriteria & "[tblSearch].[X2]= '" & Me.X2 & "'"
    myCriteria = myCriteria & " or "
    myCriteria = myCriteria & "[tblSearch].[X3]= '" & Me.X3 & "'"
    myCriteria = myCriteria & " or "
    myCriteria = myCriteria & "[tblSearch].[X4]= '" & Me.X4 & "'"
    myCriteria = myCriteria & " or "
    myCriteria = myCriteria & "[tblSearch].[X5]= '" & Me.X5 & "'"
    myCriteria = myCriteria & " or "
    myCriteria = myCriteria & "[tblSearch].[X6]= '" & Me.X6 & "'"
    myCriteria = myCriteria & " or "
    myCriteria = myCriteria & "[tblSearch].[X7]= '" & Me.X7 & "'"
    myCriteria = myCriteria & " or "
    myCriteria = myCriteria & "[tblSearch].[X8]= '" & Me.X8 & "'"
    myCriteria = myCriteria & " or "
    myCriteria = myCriteria & "[tblSearch].[X9]= '" & Me.X9 & "'"
    myCriteria = myCriteria & ")"


    Debug.Print myCriteria
    Me.Search2.Form.Filter = myCriteria
    Me.Search2.Form.FilterOn = True

 

الكود الثاني يعتمد على Sql 

    Dim mySqL               As String
    Dim mySQLWhere     As String
    Dim strSQL               As String
    Dim SqLK                As String

    SqLK = " AND "
    mySqL = "SELECT * FROM tblSearch "

    If Len(Me.X1 & vbNullString) Then
       mySQLWhere = "WHERE [X1] Like " & Chr$(39) & "*" & Me.X1 & "*" & Chr$(39)
    End If

    If Len(Me.X2 & vbNullString) Then
       mySQLWhere = "WHERE [X2] Like " & Chr$(39) & "*" & Me.X2 & "*" & Chr$(39)
    End If

    If Len(Me.X3 & vbNullString) Then
       mySQLWhere = "WHERE [X3] Like " & Chr$(39) & "*" & Me.X3 & "*" & Chr$(39)
    End If

    If Len(Me.X4 & vbNullString) Then
       mySQLWhere = "WHERE [X4] Like " & Chr$(39) & "*" & Me.X4 & "*" & Chr$(39)
    End If

    If Len(Me.X5 & vbNullString) Then
       mySQLWhere = "WHERE [X5] Like " & Chr$(39) & "*" & Me.X5 & "*" & Chr$(39)
    End If

    If Len(Me.X6 & vbNullString) Then
       mySQLWhere = "WHERE [X6] Like " & Chr$(39) & "*" & Me.X6 & "*" & Chr$(39)
    End If

    If Len(Me.X7 & vbNullString) Then
       mySQLWhere = "WHERE [X7] Like " & Chr$(39) & "*" & Me.X7 & "*" & Chr$(39)
    End If

    If Len(Me.X8 & vbNullString) Then
       mySQLWhere = "WHERE [X8] Like " & Chr$(39) & "*" & Me.X8 & "*" & Chr$(39)
    End If

    If Len(Me.X9 & vbNullString) Then
       mySQLWhere = "WHERE [X9] Like " & Chr$(39) & "*" & Me.X9 & "*" & Chr$(39)
    End If


    strSQL = mySqL & mySQLWhere
    Debug.Print strSQL


    Me.Search2.Form.RecordSource = strSQL
    Me.Search2.Requery

بالمناسبة اضفت مليون سجل ونفذت الامر بالطريقتين والحمد لله النتائج ممتازة ثواني قليلة فقط

003.rarFetching info...

تحياتي

  • Like 1
محمد أبوعبدالله

محمد أبوعبدالله

قام بنشر
قام بنشر
  في 5‏/7‏/2020 at 05:21, naseralmaky said:

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

Expand  

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

واخبرنا بالنتيجة بارك الله فيك

تحياتي

  • Like 1
naseralmaky

naseralmaky

قام بنشر
  • الكاتب
قام بنشر

طيب بالنسبة لاستيراد البيانات 
لازم اغير اسماء الحقول في جدول الاكسيل

 

محمد أبوعبدالله

محمد أبوعبدالله

قام بنشر
قام بنشر
  في 5‏/7‏/2020 at 05:25, naseralmaky said:

لازم اغير اسماء الحقول في جدول الاكسيل

Expand  

وضع لك اسماء الحقول التي تم تغييرها في حقل العنوان في الجدول

انظر اليه حتى لا يختلط عليك الامر لا قدر الله

تحياتي

naseralmaky

naseralmaky

قام بنشر
  • الكاتب
قام بنشر (معدل)

تسلم ايدك استاذي الفاضل 
بصراحة لم اتوقع سرعة في البحث مثل كده ابدا فعلا البحث سريع جدا جدا
ولكن واجهتني 3 مشاكل 
1- عند البحث (Cmd02) هو فقط الذي يعمل زر البحث الثاني لايعمل 
2- لما  تغيرت اسماء الحقول في بيانات كثيرة مش عارف اضبطها مثل رقم القيد بقي هو ID ودي مشكلة لان رقم القيد حقل اساسي 
3- كنت عامل استعلام ووبناء عليه كنت بطبع التقارير او نتائج البحث الي تظهر حاليا يعطيني خطا لان الاستعلام المبني عليه ليس موجود

لو امكن اتواصل معك خاص ؟

تم تعديل بواسطه naseralmaky
محمد أبوعبدالله

محمد أبوعبدالله

قام بنشر
قام بنشر
  في 5‏/7‏/2020 at 06:11, naseralmaky said:

1- عند البحث (Cmd02) هو فقط الذي يعمل زر البحث الثاني لايعمل 

Expand  

بالفعل كان محتاج ضبط اكثر

تفضل الكود امن جديد 

    Dim myCriteria As String
    myCriteria = Null
 
   If Not IsNull(Me.X1) Then
     myCriteria = "[X1] LIKE '*" & Me.X1 & "*'"
   End If
   
   If Not IsNull(Me.X2) Then
      myCriteria = (myCriteria + " AND ") & "[X2] LIKE '*" & Me.X2 & "*'"
   End If
  
   If Not IsNull(Me.X3) Then
     myCriteria = (myCriteria + " AND ") & "[X3] LIKE '*" & Me.X3 & "*'"
   End If
  
   If Not IsNull(Me.X4) Then
     myCriteria = (myCriteria + " AND ") & "[X4] LIKE '*" & Me.X4 & "*'"
   End If
  
   If Not IsNull(Me.X5) Then
     myCriteria = (myCriteria + " AND ") & "[X5] LIKE '*" & Me.X5 & "*'"
   End If

   If Not IsNull(Me.X6) Then
      myCriteria = (myCriteria + " AND ") & "[X6] LIKE '*" & Me.X6 & "*'"
   End If
   
   If Not IsNull(Me.X7) Then
      myCriteria = (myCriteria + " AND ") & "[X7] LIKE '*" & Me.X7 & "*'"
   End If
   
   If Not IsNull(Me.X8) Then
     myCriteria = (myCriteria + " AND ") & "[X8] LIKE '*" & Me.X8 & "*'"
   End If
  
   If Not IsNull(Me.X9) Then
     myCriteria = (myCriteria + " AND ") & "[X9] LIKE '*" & Me.X9 & "*'"
   End If
   
    Me.Search2.Form.Filter = myCriteria
    Me.Search2.Form.FilterOn = True

 

  في 5‏/7‏/2020 at 06:11, naseralmaky said:

2- لما  تغيرت اسماء الحقول في بيانات كثيرة مش عارف اضبطها مثل رقم القيد بقي هو ID ودي مشكلة لان رقم القيد حقل اساسي 

Expand  

لا مشكلة الآن ممكن نعمل على الاسماء الخاصة بك بدون مشاكل ان شاء الله

  في 5‏/7‏/2020 at 06:11, naseralmaky said:

3- كنت عامل استعلام ووبناء عليه كنت بطبع التقارير او نتائج البحث الي تظهر حاليا يعطيني خطا لان الاستعلام المبني عليه ليس موجود

Expand  

اذا كانت المشكلة في اسماء الحقول فيمكن تغيرها حسب ما كانت عليه او بالشكل الجديد بجون مشاكل ان شاء الله

  في 5‏/7‏/2020 at 06:11, naseralmaky said:

لو امكن اتواصل معك خاص ؟

Expand  

بالخدمة اخي الكريم

تحياتي

naseralmaky

naseralmaky

قام بنشر
  • الكاتب
قام بنشر

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

محمد أبوعبدالله

محمد أبوعبدالله

قام بنشر
قام بنشر
  في 6‏/7‏/2020 at 04:48, naseralmaky said:

بس ممكن تعرفني كود يطبع نتائج البحث 

Expand  

يمكنك استخدام نفس الكود واستبدال السطرينن الاخيرين فقط بـ 

    stDocName = "rep1"
    DoCmd.OpenReport stDocName, acPreview, , strSQLWhere

واستبدال  السطرينن الاخيرين  في الكود الاخير بـ 

    stDocName = "rep1"
    DoCmd.OpenReport stDocName, acPreview, , myCriteria

تحياتي

naseralmaky

naseralmaky

قام بنشر
  • الكاتب
قام بنشر

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

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

بس عملت ذي ماحضراك قولت وللاسف والله ماضبط نهائي بيطلع لي رسالة انه في خطا في الكود والبرنامج بيوقف عن العمل 
ارفقت لحضرتك نسخة لو امكن الاطلاع عليها ولو امكن ولا عليك امر طبعا 
مربعات البحث اريد عند الكتابه بها سواء الاسم الاول او الثاني او 3 مربعات بحث في نفس الوت يظهر النتيجة وليس نتيجة مربع اوحد فقط 003.zip

ولو امكن ممكن نتواصل بشكل خاص اذا في مجال 
عن طريق الايميل او الهاتف 
اذا محتاجك في شغل 

محمد أبوعبدالله

محمد أبوعبدالله

قام بنشر
قام بنشر

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

مرحبا اخي الكريم

الكود الجديد الآن يمكن التحكم بناتج البحث متاطبق وغير متاطابق (جزء من الاسم ) وذلك عن طريق المتغير chk

ويمكن التحكم بقيمة المتغير كالتالي

    chk = 0     غير متطابق
    chk = 1     متطابق

والان كود البحث كالتالي 


On Error Resume Next

    Dim mySqL               As String
    Dim mySQLWhere    As String
    Dim mySqLAnd         As String
    Dim chk As Integer
    
    ' ÛíÑ ãÊØÇÈÞ
'    chk = 0
    ' ãÊÇØÇÈÞ
    chk = 1
    
    mySqLAnd = " AND "
    mySqL = "SELECT * FROM tblSearch "
    
    If Len(Me.X1 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X1] Like " & Chr$(39) & "*" & Me.X1 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X1] = " & Chr$(39) & Me.X1 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    If Len(Me.X2 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X2] Like " & Chr$(39) & "*" & Me.X2 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X2] = " & Chr$(39) & Me.X2 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
   
       
    If Len(Me.X3 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X3] Like " & Chr$(39) & "*" & Me.X3 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X3] = " & Chr$(39) & Me.X3 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    
    If Len(Me.X4 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X4] Like " & Chr$(39) & "*" & Me.X4 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X4] = " & Chr$(39) & Me.X4 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X5 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X5] Like " & Chr$(39) & "*" & Me.X5 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X5] = " & Chr$(39) & Me.X5 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X6 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X6] Like " & Chr$(39) & "*" & Me.X6 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X6] = " & Chr$(39) & Me.X6 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X7 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X7] Like " & Chr$(39) & "*" & Me.X7 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X7] = " & Chr$(39) & Me.X7 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X8 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X8] Like " & Chr$(39) & "*" & Me.X8 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X8] = " & Chr$(39) & Me.X8 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X9 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X9] Like " & Chr$(39) & "*" & Me.X9 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X9] = " & Chr$(39) & Me.X9 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If

    If Len(mySQLWhere) Then
        mySQLWhere = Left$(mySQLWhere, Len(mySQLWhere) - (Len(mySqLAnd) - 1))
    End If

    Me.Search2.Form.Filter = mySQLWhere
    Me.Search2.Form.FilterOn = True

وكود الطباعة كالتالي 


On Error Resume Next

    Dim stDocName        As String
    Dim mySqL               As String
    Dim mySQLWhere     As String
    Dim mySqLAnd         As String
    Dim chk                    As Integer
    
    ' ÛíÑ ãÊØÇÈÞ
'    chk = 0
    ' ãÊØÇÈÞ
    chk = 1
    
    mySqLAnd = " AND "
    mySqL = "SELECT * FROM tblSearch "
    
    If Len(Me.X1 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X1] Like " & Chr$(39) & "*" & Me.X1 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X1] = " & Chr$(39) & Me.X1 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    If Len(Me.X2 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[x2] Like " & Chr$(39) & "*" & Me.X2 & "*" & Chr$(39)
        Else
            mySQLWhere = "[x2] = " & Chr$(39) & Me.X2 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
   
       
    If Len(Me.X3 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X3] Like " & Chr$(39) & "*" & Me.X3 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X3] = " & Chr$(39) & Me.X3 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    
    If Len(Me.X4 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X4] Like " & Chr$(39) & "*" & Me.X4 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X4] = " & Chr$(39) & Me.X4 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X5 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X5] Like " & Chr$(39) & "*" & Me.X5 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X5] = " & Chr$(39) & Me.X5 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X6 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X6] Like " & Chr$(39) & "*" & Me.X6 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X6] = " & Chr$(39) & Me.X6 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X7 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X7] Like " & Chr$(39) & "*" & Me.X7 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X7] = " & Chr$(39) & Me.X7 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X8 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X8] Like " & Chr$(39) & "*" & Me.X8 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X8] = " & Chr$(39) & Me.X8 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(Me.X9 & vbNullString) Then
        If (chk) Then
            mySQLWhere = "[X9] Like " & Chr$(39) & "*" & Me.X9 & "*" & Chr$(39)
        Else
            mySQLWhere = "[X9] = " & Chr$(39) & Me.X9 & Chr$(39)
        End If
           mySQLWhere = mySQLWhere & mySqLAnd
    End If
    
    
    If Len(mySQLWhere) Then
        mySQLWhere = Left$(mySQLWhere, Len(mySQLWhere) - (Len(mySqLAnd) - 1))
    End If
 
  Debug.Print mySQLWhere
  
    Me.Visible = False
    stDocName = "rep1"
    DoCmd.OpenReport stDocName, acPreview, , mySQLWhere

003.zipFetching info...

تحياتي

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

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

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

Important Information

  I accept