عمل فلتر للبيانات

[الو11111في]

السلام عليكم 

أسعد الله اوقاتكم بكل خير 
احتاج الى مساعدتكم الكريمة  ودعمكم الدائم في ادراج رابط تشعبي في صفحة رقم 1  وعند الضغط عليه ينتقل الى صفحة رقم 2  ويعمل فلتر للبيانات في في عمود J  ,  حسب قيمة ID في خلية B2 في صفحة 1 

 

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

طلب فلتر.xlsx

[محمد هشام.]

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

جرب هدا 

Sub CreateHyperlink()
    Dim targetCell As Range, Clé As String
    Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("الرئيسية")
    Dim f As Worksheet: Set f = ThisWorkbook.Sheets("التفصيلية")
    Dim lastRow As Long
    
    Clé = WS.Range("B2").Value
    
    Set targetCell = WS.Range("M2")
    
    WS.Hyperlinks.Add Anchor:=targetCell, Address:="", SubAddress:= _
        "التفصيلية!A1", TextToDisplay:="تفاصيل الطلب"
    
    If Clé <> "" Then
        f.Activate
        
        If f.AutoFilterMode Then f.AutoFilterMode = False
        
        lastRow = f.Cells(f.Rows.Count, "J").End(xlUp).Row
        
        f.Range("J2:J" & lastRow).AutoFilter Field:=1, Criteria1:=Clé
    End If
End Sub

وفي حدث ورقة الرئيسية 

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error Resume Next
    If Target.Range.Address = "$M$2" Then
        Call CreateHyperlink
    End If
End Sub

 

 

طلب فلتر.xlsb

تم تعديل أغسطس 21 بواسطه محمد هشام.

[الو11111في]

كل الشكر والتقدير   مهندس محمد 

لكن حاولت ولم يعمل , وكذلك الملف الذي ارفقته في ردك  لم يعمل  

آمل تطبيقه على الملف المرفق وجزاك الله كل خير

[محمد هشام.]

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

[الو11111في]

فقط ينتقل الى الصفحة التفصيلية بدون ان يعمل فلتر للجدول 

[محمد هشام.]

غريب  لقد أعدت تجربة الملف و الكود يشتغل بشكل جيد !!

ممكن توضح لي أكثر ما تحاول فعله؟ لكي نستطيع مساعدتك 

هل ستقوم كل مرة بإدخال قيمة معينة في الخلية B2 وفلترة البيانات عليها؟ 

بعد معاينة الملف الخاص بك أعتقد أن الطريقة الأصح أنك تقوم مثلا بإضافة عبارة (تفاصيل إظافية) على عمود M وعند الظغط عليها يتم الانتقال إلى ورقة التفضيلية وفلترة الجدول بشرط القيمة المقابلة في عمود b وهذا يمكنك فعله بدون إظافة اي ارتباطات تشعبية فقط بالاكواد 

 

تم تعديل أغسطس 22 بواسطه محمد هشام.

[الو11111في]

كل الشكر  مره أخرى على اهتمامك  مهندس محمد 

 

للتوضيح أكثر اخي الكريم   ,  اريد ان اضع رابط تشعبي في العمود M  لكل صف في الصفحة الرئيسية  ,,  حيث تكون وظيفة هذا الرابط عند الضغط عليه بالانتقال الى الورقة التفصيلية , ويعمل فلتر للبيانات حسب القيمة الموجود في العمود B  في نفس الصف في الصفحة الرئيسية  ,  علما ان العمود B في الصفحة الرئيسية  يرتبط مع العمود J في الصفحة التفصيلية يحتوي على نفس البيانات   .. كما يتضح في الصورة ادناه 

يعني هو بشكل مختصر  تنظيم وترتيب وفلتره وسهولة وصول لتفاصيل كل طلب 

اتمنى ان وفقت في ايصال الفكرة 
ٍٍ

[محمد هشام.]

هذا ما كنت أحاول فهمه كما سبق الذكر يمكنك ذالك بدون الاعتماد أو إظافة الارتباط التشعبي 

ضع الكود التالي في حدث ورقة الرئيسية 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Dim f As Worksheet: Set f = ThisWorkbook.Sheets("الرئيسية")
   
    Application.ScreenUpdating = False
    
    f.Range("M2:M" & f.Rows.Count).ClearContents
    
    ' تحديث العمود "M" بالنص "تفاصيل الطلب" لكل صف يحتوي على قيمة في العمود "B"
    For i = 2 To f.Cells(f.Rows.Count, "B").End(xlUp).Row
        If f.Cells(i, "B").Value <> "" Then
            f.Cells(i, "M").Value = "تفاصيل الطلب" ' <<=====' يمكنك تعديل النص بما يناسبك
        End If
    Next i
    
    Application.ScreenUpdating = True
    
    If Not Intersect(Target, Me.Columns("M")) Is Nothing Then
        Dim lr As Long, OneRng As Range
        Dim rCrit As String, tmp As Boolean
        
        tmp = False
        On Error Resume Next
        tmp = Not ThisWorkbook.Sheets("التفصيلية") Is Nothing
        On Error GoTo 0

        If Not tmp Then
            MsgBox "ورقة العمل التفصيلية غير موجودة", vbExclamation
            Exit Sub
        End If
        
        If Target.Row > 1 Then
            If Me.Cells(Target.Row, "M").Value <> "" And Me.Cells(Target.Row, "B").Value <> "" Then
                Dim WS As Worksheet
                Set WS = ThisWorkbook.Sheets("التفصيلية")
                
                If WS.AutoFilterMode Then WS.AutoFilterMode = False
                
                rCrit = Me.Cells(Target.Row, "B").Value
                
                If rCrit <> "" Then
                    lr = WS.Cells(WS.Rows.Count, "J").End(xlUp).Row
                    Set OneRng = WS.Range("J2:J" & lr).Find(What:=rCrit, LookIn:=xlValues, LookAt:=xlWhole)
                    
                    If Not OneRng Is Nothing Then
                        WS.Activate
                        With WS.Range("B2:O" & lr)
                            .AutoFilter 9, rCrit
                        End With
                    Else
                        MsgBox "غير موجود في قاعدة البيانات" & " : " & rCrit, 16
                    End If
                End If
            End If
        End If
    End If
End Sub

 

 

 

طلب فلتر V3.xlsb

تم تعديل أغسطس 22 بواسطه محمد هشام.
تعديل الكود

[الو11111في]

في 22‏/8‏/2024 at 14:02, محمد هشام. said:

هذا ما كنت أحاول فهمه كما سبق الذكر يمكنك ذالك بدون الاعتماد أو إظافة الارتباط التشعبي 

ضع الكود التالي في حدث ورقة الرئيسية 

الحقيقة تعجز الكلمات عن شكرك  اخي  العزيز محمد ,,  لكن أسأل الله ان يجعل ماقدمت في موازين اعمالك ويكتب لك ومن تحب التوفيق والسعادة والصحة.

عفوا مهندسنا وخبيرنا  الغالي لدي سؤال بسيط 

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

[محمد هشام.]

هل انت متأكد من تنسيق اللغة على جهازك ؟

[الو11111في]

الجهاز باللغة الانجليزية 
هل يتطلب اغيرها الى تنسيق معين ؟

[محمد هشام.]

حاول اخي الكريم مراجعة الموضوع التالي ربما يفيدك 

 

[الو11111في]

لا اعتقد ان المشكلة في الغة لانها تعمل لدي بشكل سليم  كما يظهر في الصورة المرفقة ، كذلك تم تغييرها الى Maroc ولم يتغير شي ،  ولم يعمل الحدث في الملف، لذا سأقوم بتجربته في جهاز آخر  وابلغكم بالنتيجة 
كل الشكر والتقدير والعرفان لشخصك الكريم مهندس محمد .

[الو11111في]

ولله الحمد تم ايجاد مشكلة عدم تشغيل الملف في جهازي ،  وهي ضرورة وضع علامه check  على خيار Unblock  في خصائص الملف 


شكرا جزيلا مهندس محمد ،، الملف يعمل بشكل افضل من المطلوب ،   كل الشكر والتقدير لك عزيزي.

[محمد هشام.]

لقد فكرت في هدا لاكن ماجاء في اخر مشاركة لك كان العكس 

في 23‏/8‏/2024 at 23:13, الو11111في said:

فعلت الماكرو   ولم يعمل  ايضا !

العفو اخي يسعدنا اننا استطعنا مساعدتك