درود
در این تاپیک هدف ارائه راهکاری برای جستجوی چندگانه است و قصد توضیح دادن کد هارو ندارم ، برای اجرا شدن کد ها ابتدا از مسیر VBA/Tools/Refrences گزینه Microsoft Activex Data objects رو فعال کنید
فرض کنید جدولی با داده هایی به شکل زیر دارید
هدف فیلتر کردن داده ها به صورت گام به گام و همراه با چندین شرط متفاوت و در نهایت رسیدن به رکورد مورد نیاز و نمایش آن در لیست باکس یک فرم است
گام اول:
ابتدا فرم مورد نیاز خود را طراحی کنید و آیتم های مورد نیاز خود را در قالب یک تکست باکس یا کمبو باکس ایجاد نمایید
از مسیری که در تصویر زیر مشخص شده است نسبت به نام گذاری تکست باکس ها (یا کمبو باکس ها) به روش زیر اقدام نمایید
هر تکست باکس می بایست نام ستون متناظر خود در شیت اکسل را به اضافه حروف flt در پایان آن داشته باشد به عنوان مثال ستون نام در شیت به fname نامگذاری شده است پس تکست باکس آن را با fnameflt نام گذاری کنید.
گام سوم:
کانکشن مورد نیاز به شیت حاوی داده ها ایجاد کنید ، با توجه به اینکه این کانکشن در طول اجرای سابروتین ها مورد نیاز است متغیر های مربوطه را به صورت public تعریف میکنیم:
کد زیر شیت حاوی اطلاعات را انتخاب میکند
گام سوم:
با استفاده از رویداد click کامند باتن تعبیه شده بر روی یوزر فرم کدهای زیر را وارد کنید:
این رویه در ابتدا اقدام به برقراری کانکشن نموده و با تشخیص مقادیری که شما وارد کرده اید سابروتین زیر را که اقدام به ساخت استرینگ مورد نیاز برای فیلتر کردن داده می نماید فراخوانی می کند.
گام چهارم:
بعد از ساخت استرینگ مورد نیاز قطعه کد زیر فراخوانی شده و داده ها فیلتر می شوند.
گام پنجم:
در پایان با فراخوانی سابروتین زیر داده ها در لیست باکس وارد می شود
دقت کنید در گزاره with نام لیست باکس را صحیح وارد کنید.
در این تاپیک هدف ارائه راهکاری برای جستجوی چندگانه است و قصد توضیح دادن کد هارو ندارم ، برای اجرا شدن کد ها ابتدا از مسیر VBA/Tools/Refrences گزینه Microsoft Activex Data objects رو فعال کنید
فرض کنید جدولی با داده هایی به شکل زیر دارید
هدف فیلتر کردن داده ها به صورت گام به گام و همراه با چندین شرط متفاوت و در نهایت رسیدن به رکورد مورد نیاز و نمایش آن در لیست باکس یک فرم است
گام اول:
ابتدا فرم مورد نیاز خود را طراحی کنید و آیتم های مورد نیاز خود را در قالب یک تکست باکس یا کمبو باکس ایجاد نمایید
از مسیری که در تصویر زیر مشخص شده است نسبت به نام گذاری تکست باکس ها (یا کمبو باکس ها) به روش زیر اقدام نمایید
هر تکست باکس می بایست نام ستون متناظر خود در شیت اکسل را به اضافه حروف flt در پایان آن داشته باشد به عنوان مثال ستون نام در شیت به fname نامگذاری شده است پس تکست باکس آن را با fnameflt نام گذاری کنید.
گام سوم:
کانکشن مورد نیاز به شیت حاوی داده ها ایجاد کنید ، با توجه به اینکه این کانکشن در طول اجرای سابروتین ها مورد نیاز است متغیر های مربوطه را به صورت public تعریف میکنیم:
کد PHP:
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
کد PHP:
strSQL = "select*from [sheet1$]"
گام سوم:
با استفاده از رویداد click کامند باتن تعبیه شده بر روی یوزر فرم کدهای زیر را وارد کنید:
کد PHP:
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
این رویه در ابتدا اقدام به برقراری کانکشن نموده و با تشخیص مقادیری که شما وارد کرده اید سابروتین زیر را که اقدام به ساخت استرینگ مورد نیاز برای فیلتر کردن داده می نماید فراخوانی می کند.
کد PHP:
Public Function flt(fildname As String, filtername As String)
flt = " " & fildname & " = '" & filtername & "' AND "
End Function
بعد از ساخت استرینگ مورد نیاز قطعه کد زیر فراخوانی شده و داده ها فیلتر می شوند.
کد PHP:
Sub subfilter(srtfill As String)
rsReserve.Filter = srtfill
End Sub
در پایان با فراخوانی سابروتین زیر داده ها در لیست باکس وارد می شود
کد PHP:
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
کامنت