optionbutton kullanarak birden fazla sütünda arama yaptırılması

Katılım
28 Mayıs 2007
Mesajlar
63
Excel Vers. ve Dili
2010 tr
Aşağıdaki kodlarla textbox'a girilen veriye göre arama yapılıyor. Bu arama metodunda optionbutton ile seçeceğimiz sütunlarda arama yaptırılacak şekilde düzenleyebilir mi?.

optionbutton1 "B" sütunu, optbt2 "C" sütunu, optbut3 "D" sütununda arama yaptırmak istiyorum.

Private Sub TextBox25_Change() 'VERI ARAMA'
Dim k As Range, adrs As String, j As Byte, a, sat As Long
ReDim myarr(1 To 18, 1 To 1)
If TextBox25.Text = "" Then
sat = ActiveSheet.Cells(65536, "A").End(xlUp).Row
ListBox1.RowSource = ComboBox1.Text & "!A2:S" & sat
Exit Sub
End If
Set s1 = Sheets("" & ComboBox1)
With s1
ListBox1.RowSource = ""
If .FilterMode Then .ShowAllData
Set k = .Range("A2:S65536").Find(TextBox25.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 18, 1 To a)
For j = 1 To 18
myarr(j, a) = .Cells(k.Row, j + 1).Value
Next j
Set k = s1.Range("A2:S65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With
End Sub
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki gibi deneyin.

Kod:
Private Sub TextBox25_Change() 'VERI ARAMA'
 
if optionbutton1.value=true then sut="B"
if optionbutton2.value=true then sut="C"
if optionbutton3.value=true then sut="D"

Dim k As Range, adrs As String, j As Byte, a, sat As Long
ReDim myarr(1 To 18, 1 To 1)
If TextBox25.Text = "" Then
sat = ActiveSheet.Cells(65536, "A").End(xlUp).Row
ListBox1.RowSource = ComboBox1.Text & "!A2:S" & sat
Exit Sub
End If
Set s1 = Sheets("" & ComboBox1)
With s1
ListBox1.RowSource = ""
If .FilterMode Then .ShowAllData
Set k = .Range(sut & "2:" & sut & "65536").Find(TextBox25.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 18, 1 To a)
For j = 1 To 18
myarr(j, a) = .Cells(k.Row, j + 1).Value
Next j
Set k = s1.Range(sut & "2:" & sut & "65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With
End Sub
 
Katılım
28 Mayıs 2007
Mesajlar
63
Excel Vers. ve Dili
2010 tr
Sayın Menteşoğlu, cevabınız için teşekkürler gayet güzel çalışıyor.:mutlu:
 
Son düzenleme:
Üst