- Katılım
- 25 Aralık 2007
- Mesajlar
- 335
- Excel Vers. ve Dili
- exel 2000 türkçe
ekteki dosya muhasebe programı olmaya aday
Private Sub filtre_Change()
Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(2 To 7, 1 To 1)
With Worksheets("Sayfa1")
Me.ListBox1.Clear
Set k = .Range("A2:A65536").Find(filtre.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(2 To 7, 1 To a)
For j = 2 To 7
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = Range("A2:A65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With
ListBox1.ColumnCount = 7
ListBox1.ColumnWidths = "55;45;45;90;200;60"
End Sub
bu şekilde listeyi süzdürüyorum ve a sutunda sadece filtre textboxındaki durumu listeliyorum
ancak
double clickle değiştirmek veya silmek için bilgileri tekrar textboxlara almak istedigimde
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
filtre = ListBox1.List(ListBox1.ListIndex, 0)
TextBox1 = ListBox1.List(ListBox1.ListIndex, 1)End Sub
hatasını veriyor
nasıl düzeltebilirim
lütfen acil yardım
Private Sub filtre_Change()
Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(2 To 7, 1 To 1)
With Worksheets("Sayfa1")
Me.ListBox1.Clear
Set k = .Range("A2:A65536").Find(filtre.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(2 To 7, 1 To a)
For j = 2 To 7
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = Range("A2:A65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With
ListBox1.ColumnCount = 7
ListBox1.ColumnWidths = "55;45;45;90;200;60"
End Sub
bu şekilde listeyi süzdürüyorum ve a sutunda sadece filtre textboxındaki durumu listeliyorum
ancak
double clickle değiştirmek veya silmek için bilgileri tekrar textboxlara almak istedigimde
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
filtre = ListBox1.List(ListBox1.ListIndex, 0)
TextBox1 = ListBox1.List(ListBox1.ListIndex, 1)End Sub
hatasını veriyor
nasıl düzeltebilirim
lütfen acil yardım
Ekli dosyalar
-
93.9 KB Görüntüleme: 5
-
122.5 KB Görüntüleme: 18