إظهار وإخفاء بقيمة خلية

[ابو ذكري]

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

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

وارجوا ان اجد حلا لهذا الامر طرف عباقرة الاوفيس في اوفيسنا

مرفق شيت كروت العملاء

في ورقة العمل كروت العملاء يتم التعامل برقم العميل

ونظرا لطول الصفحة فاتمنى كود إخفاء ما تحت خلية البحث حتى الكود الذي يتم البحث عنه في خلية البحث

في الملف المرفق العميل رقم 0405 يبدأ من الصف 120 وهو مدى متغير وغير ثابت

في حال الحث في خلية البحث عن 0405 يتم اخفاء الصفوف من 3 حتى 119

في الملف المرفق العميل رقم 0406 يبدأ من الصف 240 وهو مدى متغير وغير ثابت

في حال الحث في خلية البحث عن 0405 يتم اخفاء الصفوف من 3 حتى 239

وفي حال البحث عن اول كود 0401 يتم اظهار كل ورقة العمل

 

برجاء اقتصار العمل على ورقة العمل ( كروت العملاء فقط )

 

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

كروت عملاء.rar

تم تعديل أبريل 27, 2017 بواسطه ابو ذكري
إضافة ملاحظة

[ابو ذكري]

برجاء من الاخوة المشرفين او احد الاخوة الاعضاء ايجاد حل ان كان هناك حل

او اخبارنا بان هذا الامر لا يمكن ان يتم لايجاد بدائل ممكنة

ولكم جزيل الشكر ووافر الاحترام

[ابراهيم الحداد]

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

انسخ هذا الكود والصقه فى موديول وخصص له زر

Sub HidRang()
Dim rng As Range, cel As Range
Dim LR As Long, x As Long, y As Long
LR = Sheets("كروت عملاء").Range("B" & Rows.Count).End(xlUp).row
Application.ScreenUpdating = False
Set rng = Sheets("كروت عملاء").Range("B5:B" & LR)
rng.Rows.EntireRow.Hidden = False
For Each cel In rng
If cel.Value = Sheets("كروت عملاء").Range("B2") Then
x = cel.row
y = x - 3
Rows("3:" & y).EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub

 

[ابو ذكري]

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

هناك درس كنت اتابعة وجربتة على هذا الكود وعمل بشكل رائع

قمت بنسخ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range, cel As Range
Dim LR As Long, x As Long, y As Long
LR = Sheets("ßÑæÊ ÚãáÇÁ").Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Set rng = Sheets("ßÑæÊ ÚãáÇÁ").Range("B5:B" & LR)
rng.Rows.EntireRow.Hidden = False
For Each cel In rng
If cel.Value = Sheets("ßÑæÊ ÚãáÇÁ").Range("B2") Then
x = cel.Row
y = x - 2
Rows("4:" & y).EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub

مما ادى الى تنفيذ المطلوب بالضغط على ENTER

مرة أخرى لكم جزيل الشكر

 

الى ورقة العمل