تعديل كود في البحث باستخدام ليست

[hanykassem]

السلام عليكم 

ممكن معرفه الخطا في هذا الكود 

 

test.xlsm

تم تعديل يونيو 25, 2023 بواسطه hanykassem

[محمد هشام.]

تفضل اخي ربما هدا ما تقصده 

Sub ChangeColor()
Dim lrow&

Dim WS1 As Worksheet: Set WS1 = Sheets("Raw Data")
Dim WS2 As Worksheet: Set WS2 = Sheets("Do Not Include")

lrow = WS1.Range("B" & Rows.Count).End(xlUp).Row
Rng = WorksheetFunction.CountA(WS1.Range("A4", WS1.Range("A4").End(xlDown))) + 3

Application.ScreenUpdating = False
WS1.Activate
WS1.Range(Cells(5, 2), Cells(Rng, 2)).Interior.ColorIndex = 0
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
  End If

Set r = WS1.Range("B5:B" & lrow)
For Each cell In r
If cell.Value = WS2.Range("A1") Then
    cell.Interior.Color = RGB(34, 153, 166)
    cell.Select
     
     End If
    Next
    
 Application.ScreenUpdating = True

End Sub

 

 

test 7.xlsm

تم تعديل يونيو 25, 2023 بواسطه Mohamed Hicham

[hanykassem]

الاول اشكرك على اهتمامك ومجهودك الرائع 

بس للاسف مش دة طلبي

اللون ملوش علاقه انا حطيت اللون  للتوضيح فقط 

انا محتاج اي حاجه اكتبها في الشيت sheet2 "A1"

Sheet 1يعمل فليتر في الشيت الاول 

واحب اشكرك مرة آخرة

 

[محمد هشام.]

تفضل جرب اخي  فلترة البيانات بقيمة الخلية (A1) يمكنك استخدام الكود التالي 

Sub Filter_Data()  
Dim Rng As Range
Dim Crite As Worksheet: Set Crite = Sheets("Raw Data")
Dim CFilter As Worksheet: Set CFilter = Sheets("Do Not Include")
lrow = Crite.Range("B" & Rows.Count).End(xlUp).Row
Réf = CFilter.[A1]
On Error Resume Next
If Réf = Empty Then: Exit Sub
Crite.AutoFilter.ShowAllData
  
  Set Rng = Crite.Range("B6:B" & lrow).Find("*", Réf, LookIn:=XlFindLookIn.xlFormulas, _
          lookat:=xlWhole, _
          SearchDirection:=xlPrevious)

Application.ScreenUpdating = False
Crite.Range("A4:E" & lrow).AutoFilter Field:=2, Criteria1:=Réf
     Crite.Activate
 On Error GoTo 0
 Application.ScreenUpdating = True
 
End Sub

 

 

test 8.xlsm

تم تعديل يونيو 26, 2023 بواسطه Mohamed Hicham

[محمد هشام.]

إليك حل اخر  لفلترة البيانات بعدة معايير 

Option Explicit

Public Sub Filter_data()
Dim lo As ListObject, rng As Range
Dim rw As Long, i As Long
Dim arrayCriteria()
    Set lo = Range("Clé").ListObject
    rw = lo.ListRows.Count
    ReDim arrayCriteria(rw)
    For i = 1 To rw
       arrayCriteria(i) = CStr(lo.DataBodyRange.Cells(i, 1))
    Next i
    Set rng = Range("Tbl")
    With rng.ListObject
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter field:=2, Criteria1:=arrayCriteria, Operator:=xlFilterValues
    End With
End Sub
''''''''''''''''''''''''''''''''''''''''''
Public Sub Reset_filter()
Dim rng As Range
    Set rng = Range("Tbl")
    With rng.ListObject
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
    End With
End Sub

 

TEST V2.xlsm

تم تعديل يونيو 26, 2023 بواسطه Mohamed Hicham

[hanykassem]

On 6/26/2023 at 8:11 AM, Mohamed Hicham said:

إليك حل اخر  لفلترة البيانات بعدة معايير 

Option Explicit

Public Sub Filter_data()
Dim lo As ListObject, rng As Range
Dim rw As Long, i As Long
Dim arrayCriteria()
    Set lo = Range("Clé").ListObject
    rw = lo.ListRows.Count
    ReDim arrayCriteria(rw)
    For i = 1 To rw
       arrayCriteria(i) = CStr(lo.DataBodyRange.Cells(i, 1))
    Next i
    Set rng = Range("Tbl")
    With rng.ListObject
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter field:=2, Criteria1:=arrayCriteria, Operator:=xlFilterValues
    End With
End Sub
''''''''''''''''''''''''''''''''''''''''''
Public Sub Reset_filter()
Dim rng As Range
    Set rng = Range("Tbl")
    With rng.ListObject
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
    End With
End Sub

 

TEST V2.xlsm 20.13 kB · 7 downloads

1.  

 

On 6/26/2023 at 8:11 AM, Mohamed Hicham said:

إليك حل اخر  لفلترة البيانات بعدة معايير 

Option Explicit

Public Sub Filter_data()
Dim lo As ListObject, rng As Range
Dim rw As Long, i As Long
Dim arrayCriteria()
    Set lo = Range("Clé").ListObject
    rw = lo.ListRows.Count
    ReDim arrayCriteria(rw)
    For i = 1 To rw
       arrayCriteria(i) = CStr(lo.DataBodyRange.Cells(i, 1))
    Next i
    Set rng = Range("Tbl")
    With rng.ListObject
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter field:=2, Criteria1:=arrayCriteria, Operator:=xlFilterValues
    End With
End Sub
''''''''''''''''''''''''''''''''''''''''''
Public Sub Reset_filter()
Dim rng As Range
    Set rng = Range("Tbl")
    With rng.ListObject
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
    End With
End Sub

 

 

 

 

الكلمه اللي في الصورة المرفقه هي اية ؟

هل ممكن اعمل علي اكتر من عمود مثل العمود  

(B,C,E) IN (Tb1)

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

 

TEST V2.xlsm 20.13 kB · 7 downloads

 

 

TEST V2.1.xlsm

تم تعديل يونيو 27, 2023 بواسطه hanykassem

[محمد هشام.]

clé  هو نطاق وضع معايير الفلترة 

اما بخصوص فلترة البيانات بشرط عدة اعمدة نعم يمكنك دالك لاكن هدا لم يكن ضمن طلبك اول مرة خاصة انك طلبت فقط تعديل الكود المرفق.و لكي لا تتداخل المواضيع في بعضها البعض 

ربما تحتاج لفتح موضوع جديد بطلبك وسوف نكون سعداء بمساعدتك .