آموزش فیلتر داده ها بر مبنای چند محدودیت اختیاری و نمایش در لیست باکس

[~M*E*H*D*I~]

درود

در این تاپیک هدف ارائه راهکاری برای جستجوی چندگانه است و قصد توضیح دادن کد هارو ندارم ، برای اجرا شدن کد ها ابتدا از مسیر VBA/Tools/Refrences گزینه Microsoft Activex Data objects رو فعال کنید

فرض کنید جدولی با داده هایی به شکل زیر دارید

هدف فیلتر کردن داده ها به صورت گام به گام و همراه با چندین شرط متفاوت و در نهایت رسیدن به رکورد مورد نیاز و نمایش آن در لیست باکس یک فرم است
گام اول:
ابتدا فرم مورد نیاز خود را طراحی کنید و آیتم های مورد نیاز خود را در قالب یک تکست باکس یا کمبو باکس ایجاد نمایید

از مسیری که در تصویر زیر مشخص شده است نسبت به نام گذاری تکست باکس ها (یا کمبو باکس ها) به روش زیر اقدام نمایید

هر تکست باکس می بایست نام ستون متناظر خود در شیت اکسل را به اضافه حروف flt در پایان آن داشته باشد به عنوان مثال ستون نام در شیت به fname نامگذاری شده است پس تکست باکس آن را با fnameflt نام گذاری کنید.

گام سوم:
کانکشن مورد نیاز به شیت حاوی داده ها ایجاد کنید ، با توجه به اینکه این کانکشن در طول اجرای سابروتین ها مورد نیاز است متغیر های مربوطه را به صورت public تعریف میکنیم:

Public cnn As ADODB.Connection
Public rsReserve As ADODB.Recordset
Public Sub constr()
Dim strSQL As String
Dim fpath As String
Dim str As String
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rsReserve = New ADODB.Recordset
fpath = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name
str = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=""" _
                        & fpath & """;Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
strSQL = "select*from [sheet1$]"
cnn.Open str
rsReserve.Open strSQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
End Sub 

کد زیر شیت حاوی اطلاعات را انتخاب میکند

strSQL = "select*from [sheet1$]" 

گام سوم:
با استفاده از رویداد click کامند باتن تعبیه شده بر روی یوزر فرم کدهای زیر را وارد کنید:

Private Sub CommandButton1_Click()
Dim cCont As Control
Dim fildname As String
Dim filtername As String
Dim srtfill As String
Call constr
    For Each cCont In Me.Controls
If UCase(Right(cCont.Name, 3)) = "FLT" Then
fildname = Mid(cCont.Name, 1, Len(cCont.Name) - 3)
filtername = cCont.Value
If filtername <> "" Then
srtfill = srtfill & flt(fildname, filtername)

End If
End If

    Next cCont
   srtfill = Mid(srtfill, 1, Len(srtfill) - 5)
    Call subfilter(srtfill)
       Call filllistbox

Set rsReserve = Nothing
Set rs = Nothing
cnn.Close
End Sub 

این رویه در ابتدا اقدام به برقراری کانکشن نموده و با تشخیص مقادیری که شما وارد کرده اید سابروتین زیر را که اقدام به ساخت استرینگ مورد نیاز برای فیلتر کردن داده می نماید فراخوانی می کند.

Public Function flt(fildname As String, filtername As String)
flt = " " & fildname & "  =    '" & filtername & "' AND "
End Function 

گام چهارم:

بعد از ساخت استرینگ مورد نیاز قطعه کد زیر فراخوانی شده و داده ها فیلتر می شوند.

Sub subfilter(srtfill As String)
rsReserve.Filter = srtfill
End Sub 

گام پنجم:

در پایان با فراخوانی سابروتین زیر داده ها در لیست باکس وارد می شود

Private Sub filllistbox()

    Dim I As Integer, J As Integer

    With ListBox1
   
        .BoundColumn = 1
        .ColumnCount = rsReserve.Fields.Count
        .ColumnHeads = False
        .ColumnWidths = ""
        .ControlSource = ""
        .RowSource = ""
        .Clear
        I = 0
     
        If Not rsReserve.BOF Then rsReserve.MoveFirst
        If rsReserve.EOF = True Then
        MsgBox "this record nor exist"
        End If
        Do Until rsReserve.EOF
            I = I + 1
            .AddItem
            For J = 1 To .ColumnCount
                .List(I - 1, J - 1) = rsReserve.Fields(J - 1).Value
            Next J
           rsReserve.MoveNext
        Loop
    End With


End Sub 

دقت کنید در گزاره with نام لیست باکس را صحیح وارد کنید.

[hamedpersian]

سلام
ممنون. اما چرا از جدا.ل محوری (pivottable) استفاده نکنیم؟
با اونم خیلی راحت میشه همین کار رو انجام داد. نظرتون چیه؟

[~M*E*H*D*I~]

سلام
ممنون. اما چرا از جدا.ل محوری (pivottable) استفاده نکنیم؟
با اونم خیلی راحت میشه همین کار رو انجام داد. نظرتون چیه؟

راه که زیاده
پیشنهاد میکنم برای این موردی که مطرح کردید یک آموزش تهیه کنید که همه بهره ببریم

[4017]

با سلام
يه سوال
چطوري ليست باكس اين فرم از راست به چپ شده؟(البته معذرت ميخوام كه از اينهمه ماكروهاي قابل تحسين نظرم به اين مورد جلب شده)

[~M*E*H*D*I~]

البته اگر منظور شمارو درست متوجه شده باشم
تصویر پیوست رو مشاهده کنید

[4017]

با تشكر از پاسخ شما
منظور من ستون هاي اين ليست باكسه كه از راست رديف/نام و ... داره
درحالي كه معمولا توي ليست باكس رديف يا هر ستون اولي كه ميخوايم نمايش بديم از چپ شروع ميشه

[4017]

با تشكر از پاسخ شما
منظور من ستون هاي اين ليست باكسه كه از راست رديف/نام و ... داره
درحالي كه معمولا توي ليست باكس رديف يا هر ستون اولي كه ميخوايم نمايش بديم از چپ شروع ميشه

دوستان اساتيد كسي نظري نداره؟

[khakzad]

سلام
جناب وطن پرست پاسخ شما رو دادن!!1
اون تنظیم رو انجام میدید
اما موقع تخصیص داده ها به لیست باکس به این دقت کنید که الولین مورد رو میاره از سمت چپ، پس باید اخرین مورد رو در ستون اول قرار بدید و همینطور به ترتیب
یعنی از اخر بیاید اول

[4017]

سلام
جناب وطن پرست پاسخ شما رو دادن!!1
اون تنظیم رو انجام میدید
اما موقع تخصیص داده ها به لیست باکس به این دقت کنید که الولین مورد رو میاره از سمت چپ، پس باید اخرین مورد رو در ستون اول قرار بدید و همینطور به ترتیب
یعنی از اخر بیاید اول

پاسخ شما متين
اما من توي همين فايلي كه اينجا پيوست شده ديدم كه ستونها از راست به چپ چيده شدن و ليست باكس هم همينو نشون داده. بازم ممنون

[~M*E*H*D*I~]

پاسخ شما متين
اما من توي همين فايلي كه اينجا پيوست شده ديدم كه ستونها از راست به چپ چيده شدن و ليست باكس هم همينو نشون داده. بازم ممنون

تو فایل پیوست جدول اطلاعات به عنوان سورس لیست باکس داده شده روش شما هم به همین صورته یا خیر؟

[4017]

تو فایل پیوست جدول اطلاعات به عنوان سورس لیست باکس داده شده روش شما هم به همین صورته یا خیر؟

راستش من تو بر اين فايل رفتم اما سر در نياوردم كه سورس اين جدول از كجا داده شده. من از طريق rowsurce آدرس دهي ميكنم

[~M*E*H*D*I~]

راستش من تو بر اين فايل رفتم اما سر در نياوردم كه سورس اين جدول از كجا داده شده. من از طريق rowsurce آدرس دهي ميكنم

فایلت رو بذار تا بررسی بشه چون همون جواب اولی که دادم راهکار سوال بود اما شاید ایراد از جای دیگه باشه

[4017]

فایلت رو بذار تا بررسی بشه چون همون جواب اولی که دادم راهکار سوال بود اما شاید ایراد از جای دیگه باشه

درسته با اون جواب ميشه انجامش داد. اما اين حس كنجكاوي من گل كرده و خواستم بدونم اينجا چه كاري كرده كه ليست باكسش از راست چيده شده

[~M*E*H*D*I~]

فایل و تصویر پیوست رو ببین

[4017]

ممنون
جدول من به شكل tabel تغيير كرده اما تو فرم بازم همونه. ستونها از چپ چيده شده