AW: code erweitern
07.07.2005 10:23:07
mehmet
hallo zusammen,
ich habe beide variante versucht ohne erfolg
es handelt sich um ein textbox: suchen eingabe
listbox: gefundene strings auflisten
z.z. wird der suchbereich nur in tabelle1 gemacht
kann man es nicht in allen tabellen machen?
dank und gruss
mehmet
'#######################################################################
'DieseArbeitsmappe
Option Explicit
Private Sub Workbook_Open()
GetObject ("C:\Dokumente und Einstellungen\SiM\Desktop\Blanko0.xls")
End Sub
'#######################################################################
'Tabelle1
Option Explicit
'
Private Sub ListBox1_Click()
' Dim ws As Worksheet
' For Each ws In Workbooks("Blanko0.xls")
' ws.Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & _
' CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1:G1")
' Next ws
'End Sub
'
Private Sub ListBox1_Click()
' Dim i%, z%
' With Workbooks("Blanko0.xls")
' For i = 1 To .Worksheets.Count
' .Sheets(i).Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & _
' CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1").Offset(z, 0)
' z = z + 1
' Next i
' End With
'End Sub
Private Sub ListBox1_Click()
Workbooks("Blanko0.xls").Sheets(1).Range("A" & CStr(ListBox1.List(ListBox1.ListIndex, 1)) & ":G" & CStr(ListBox1.List(ListBox1.ListIndex, 1))).Copy ActiveSheet.Range("A1:G1")
End Sub
Private Sub TextBox1_Change()
Dim n As Integer 'NACHTRAG
Dim Zelle As Range, Adresse As String
ListBox1.Clear
For n = 1 To ThisWorkbook.Worksheets.Count 'NACHTRAG
With Workbooks("Blanko0.xls").Sheets(n).Range("A2:G9999") 'NACHTRAG
' With Workbooks("Blanko0.xls").Sheets(1).Range("A2:G9999")
Set Zelle = .Find(What:=TextBox1.Value, LookAt:=xlPart)
If Not Zelle Is Nothing Then
Adresse = Zelle.Address
Do
ListBox1.AddItem Zelle.Value
ListBox1.List(ListBox1.ListCount - 1, 1) = Zelle.Row
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
End With
Next n 'NACHTRAG
If Adresse <> "" Then Call sortieren(0, ListBox1.ListCount - 1)
End Sub
Private Sub sortieren(Untergrenze As Long, Obergrenze As Long)
Dim index1 As Long, index2 As Long, Element1 As String, Element2 As Long, Zwischenspeicher As String
index1 = Untergrenze
index2 = Obergrenze
Zwischenspeicher = ListBox1.List(((Untergrenze + Obergrenze) / 2) \ 1, 0)
Do
Do While ListBox1.List(index1, 0) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < ListBox1.List(index2, 0)
index2 = index2 - 1
Loop
If index1 <= index2 Then
Element1 = ListBox1.List(index1, 0)
Element2 = ListBox1.List(index1, 1)
ListBox1.List(index1, 0) = ListBox1.List(index2, 0)
ListBox1.List(index1, 1) = ListBox1.List(index2, 1)
ListBox1.List(index2, 0) = Element1
ListBox1.List(index2, 1) = Element2
index1 = index1 + 1
index2 = index2 - 1
End If
Loop Until index1 > index2
If Untergrenze < index2 Then Call sortieren(Untergrenze, index2)
If index1 < Obergrenze Then Call sortieren(index1, Obergrenze)
End Sub
'#######################################################################