پرسش فیلتر کردن از یک شیت دیگر

[mohammad711025]

با سلام
وقت همگی بخیر باشه
بنده یک فایل اکسل آپلود کردم که میخواستم چندتا کار که وابسته به هم هستند انجام بشه و در دو مرحله توضیح میدم خدمتتون

مرحله 1. از شیت "داشبرد" بتونم جدول شیت "سفر" فیلتر کنم. فیلتر هم بر اساس 9 تا ستون هستش

مرحله 2. در شیت سفر وقتی که فیلتر انجام میشه در ستون "کد سفر" کد سفرهایی که باقی مونده شده رو در شیت "نظرسنجی" و ستون کد سفر فیلتر کنه.

این روش یکی از روش های موجوده و ممکنه خیلی راه های زیادی وجود داشته باشه ولی اینکه فیلترها در شیت داشبرد انجام بشه کاربردی تره. و احتمالا راه ها در نوع فیلتر کردن باشه.
ممنونم از تمامی دوستان

[M_ExceL]

با سلام
وقت همگی بخیر باشه
بنده یک فایل اکسل آپلود کردم که میخواستم چندتا کار که وابسته به هم هستند انجام بشه و در دو مرحله توضیح میدم خدمتتون

مرحله 1. از شیت "داشبرد" بتونم جدول شیت "سفر" فیلتر کنم. فیلتر هم بر اساس 9 تا ستون هستش

مرحله 2. در شیت سفر وقتی که فیلتر انجام میشه در ستون "کد سفر" کد سفرهایی که باقی مونده شده رو در شیت "نظرسنجی" و ستون کد سفر فیلتر کنه.

این روش یکی از روش های موجوده و ممکنه خیلی راه های زیادی وجود داشته باشه ولی اینکه فیلترها در شیت داشبرد انجام بشه کاربردی تره. و احتمالا راه ها در نوع فیلتر کردن باشه.
ممنونم از تمامی دوستان

سلام،
ابتدا ماکرو رو فعال کنید سپس داخل شیت dashboard ، اطلاعات رو وارد کرده سپس روی باتن فیلتر کلیک کنید.
با وارد کردن ابتدای حرف یا شماره جهت فیلتر، ادامه آن بصورت خود کار تکمیل می شود و اگر اطلاعاتی اضافه گردد بصورت داینامیک بروز می گردد.

Sub M_E()
p = False
Application.ScreenUpdating = False
Sheets(2).AutoFilterMode = False
Sheets(2).Range("a1:n1").AutoFilter
    If Range("a2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=2, Criteria1:=Range("a2"): p = True
    If Range("b2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=3, Criteria1:=Range("b2"): p = True
    If Range("c2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=4, Criteria1:=Range("c2"): p = True
    If Range("d2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=8, Criteria1:=Range("d2"): p = True
    If Range("e2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=9, Criteria1:=Range("e2"): p = True
    If Range("f2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=10, Criteria1:=Range("f2"): p = True
    If Range("g2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=11, Criteria1:=Range("g2"): p = True
    If Range("h2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=12, Criteria1:=Range("h2"): p = True
    If Range("i2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=13, Criteria1:=Range("i2"): p = True
    If p = False Then Sheets(2).AutoFilterMode = False: Sheets(3).AutoFilterMode = False: Exit Sub
Sheets("F").Columns(1).ClearContents
Sheets("safar").Range("d2:d" & Rows.Count).Copy
Sheets("F").Range("a1").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Sheets("F").Range("a1:a" & Rows.Count).RemoveDuplicates Columns:=1, Header:=xlYes
Dim myArray()
    Sheets("N").AutoFilterMode = False
    lr = Sheets("F").Cells(Rows.Count, 1).End(3).Row
        ReDim Preserve myArray(1 To lr)
            For i = 1 To lr
                myArray(i) = "" & Sheets("F").Range("a" & i).Value & ""
            Next i
    Sheets("N").Range("A1").AutoFilter
   Sheets("N").Range("A1").AutoFilter Field:=1, Criteria1:=myArray, Operator:=xlFilterValues
Application.ScreenUpdating = True
End Sub

یا حق.

[mohammad711025]

سلام،
ابتدا ماکرو رو فعال کنید سپس داخل شیت dashboard ، اطلاعات رو وارد کرده سپس روی باتن فیلتر کلیک کنید.
با وارد کردن ابتدای حرف یا شماره جهت فیلتر، ادامه آن بصورت خود کار تکمیل می شود و اگر اطلاعاتی اضافه گردد بصورت داینامیک بروز می گردد.

Sub M_E()
p = False
Application.ScreenUpdating = False
Sheets(2).AutoFilterMode = False
Sheets(2).Range("a1:n1").AutoFilter
    If Range("a2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=2, Criteria1:=Range("a2"): p = True
    If Range("b2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=3, Criteria1:=Range("b2"): p = True
    If Range("c2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=4, Criteria1:=Range("c2"): p = True
    If Range("d2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=8, Criteria1:=Range("d2"): p = True
    If Range("e2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=9, Criteria1:=Range("e2"): p = True
    If Range("f2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=10, Criteria1:=Range("f2"): p = True
    If Range("g2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=11, Criteria1:=Range("g2"): p = True
    If Range("h2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=12, Criteria1:=Range("h2"): p = True
    If Range("i2") <> "" Then Sheets(2).Range("a1:n1").AutoFilter Field:=13, Criteria1:=Range("i2"): p = True
    If p = False Then Sheets(2).AutoFilterMode = False: Sheets(3).AutoFilterMode = False: Exit Sub
Sheets("F").Columns(1).ClearContents
Sheets("safar").Range("d2:d" & Rows.Count).Copy
Sheets("F").Range("a1").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Sheets("F").Range("a1:a" & Rows.Count).RemoveDuplicates Columns:=1, Header:=xlYes
Dim myArray()
    Sheets("N").AutoFilterMode = False
    lr = Sheets("F").Cells(Rows.Count, 1).End(3).Row
        ReDim Preserve myArray(1 To lr)
            For i = 1 To lr
                myArray(i) = "" & Sheets("F").Range("a" & i).Value & ""
            Next i
    Sheets("N").Range("A1").AutoFilter
   Sheets("N").Range("A1").AutoFilter Field:=1, Criteria1:=myArray, Operator:=xlFilterValues
Application.ScreenUpdating = True
End Sub

یا حق.

خیلی ممنونم
چند تا سوال فقط داشتم

1. امکانش هستش که به صورت کمبوباکس باشه

2. و اینکه اگه یکی از فیلر هارو تایپ کردیم اگه برای بعضی از فیلد ها فیلتری وجود نداشت نشون نده (به فرض اگه برای استاد یکی از اساتید رو فیلتر کردیم و برای سرچ راهنما فقط اون راهنماهایی رو بشه انتخاب کرد که در فیلتر شده استاد هستند یعنی فیلتر به لحظه باشه)

ممنونم از شما