جستجو در اکسل با کدنویسی

حامد محمودخانی

6 سال پیش

با سلا خدمت کاربران عزیز سایت آی تی سواد

این مقاله روشی را برای شما فراهم می‌کند که فورا ً همان طور که در یک سلول در اکسل تایپ می‌کنید ، جستجو کنید و فیلتر کنید .

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

جستجو در اکسل با کد نویسی

۱. اول،شما باید جدولی را با داده‌های لیست ایجاد کنید، و جدول را به نام “Name” نامگذاریکنید.لطفاً تمام لیست را انتخاب کنید و گزینه Insert > Table را کلیک کنید.

۲. در پنجره باز شده Create Table روی OK کلیک کنید.

۳. روی هر سلول از جدول کلیک کنید تا زبانه Design را فعال کنید، و سپس Table Name را به نام Name تغییر دهید.

۴. روی ( Developer > Insert > Text Box (ActiveX Control) کلیک کنید تا یکجعبه متنی را در بالای فهرست جدول قرار دهید، همانطور که عکس زیر نشان داده شد:

۵. روی کادر متن کلیک کرده و روی Properties، در پنجره Properties ، سلول مرجع را درجعبه LinkedCell تایپ کنید.

۶. روی کادر متن کلیک کرده و View Code را از منوی متنی انتخاب کنید. سپس کد VBA زیر رادر پنجره Microsoft Visual Basic for Applications به جای کد اصلی جایگزین کنید.

کد VBA: جستجوی فیلتر خودکار زمانی که شما در اکسل تایپ می‌کنید.

Private Sub TextBox1_Change()
'Update by Extendoffice 2018/08/22
Dim xStr, xName As String
Dim xWS As Worksheet
Dim xRg As Range
    On Error GoTo Err01
    Application.ScreenUpdating = False
    xName = "Name"
    xStr = TextBox1.Text
    Set xWS = ActiveSheet
    Set xRg = xWS.ListObjects(xName).Range
    If xStr <> "" Then
        xRg.AutoFilter field:=1, Criteria1:="*" & xStr & "*", Operator:=xlFilterValues
    Else
        xRg.AutoFilter field:=1, Operator:=xlFilterValues
    End If
Err01:
Application.ScreenUpdating = True
End Sub

Private Sub TextBox1_Change()

'Update by Extendoffice 2018/08/22

Dim xStr, xName As String

Dim xWS As Worksheet

Dim xRg As Range

On Error GoTo Err01

Application.ScreenUpdating = False

xName = "Name"

xStr = TextBox1.Text

Set xWS = ActiveSheet

Set xRg = xWS.ListObjects(xName).Range

If xStr <> "" Then

xRg.AutoFilter field:=1, Criteria1:="*" & xStr & "*", Operator:=xlFilterValues

Else

xRg.AutoFilter field:=1, Operator:=xlFilterValues

End If

Err01:

Application.ScreenUpdating = True

End Sub

نکته : در کد ، نام جعبه متن گذاشته شده TextBox1 نام دارد ،name نام فهرست جدول است . شما می‌توانید آن‌ها را براساس نیازهای خود تغییر دهید .

۷. کلیدهای Alt + Q را فشار دهید تا Microsoft Visual Basic for Applications بسته شود .

۸. با کلیک روی Developer > Design Mode.، مد طراحی را خاموش کنید .

از این به بعد ، براساس مقدار وارد شده در جعبه متن جستجو فیلتر بلافاصله انجام خواهد شد .

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

Private Sub TextBox1_Change()
'Update by Extendoffice 2018/08/22
Dim xStr, xName As String
Dim xWS As Worksheet
Dim xRg As Range
    On Error GoTo Err01
    Application.ScreenUpdating = False
    xName = "Name"
    xStr = TextBox1.Text
    Set xWS = ActiveSheet
    Set xRg = xWS.ListObjects(xName).Range
    If xStr <> "" Then
        If IsNumeric(xStr) Then
    xRg.AutoFilter field:=1, Criteria1:=xStr
        End If
        xRg.AutoFilter field:=1, Criteria1:="*" & xStr & "*", Operator:=xlFilterDynamic
    Else
        xRg.AutoFilter field:=1, Operator:=xlFilterValues
    End If
    
Err01:
Application.ScreenUpdating = True
End Sub

Private Sub TextBox1_Change()

'Update by Extendoffice 2018/08/22

Dim xStr, xName As String

Dim xWS As Worksheet

Dim xRg As Range

On Error GoTo Err01

Application.ScreenUpdating = False

xName = "Name"

xStr = TextBox1.Text

Set xWS = ActiveSheet

Set xRg = xWS.ListObjects(xName).Range

If xStr <> "" Then

If IsNumeric(xStr) Then

xRg.AutoFilter field:=1, Criteria1:=xStr

End If

xRg.AutoFilter field:=1, Criteria1:="*" & xStr & "*", Operator:=xlFilterDynamic

Else

xRg.AutoFilter field:=1, Operator:=xlFilterValues

End If

Err01:

Application.ScreenUpdating = True

End Sub

ترجمه شده از سایت www.extendoffice.com

ممنون از همراهی شما کاربران عزیز سایت آی تی سواد

اشتراک گذاری

بیشتر