Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1280to1284
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Suchfunktion optimieren

Suchfunktion optimieren
10.10.2012 10:11:55
Frank
Hallo Forummitglieder,
ich habe ein kleines Anliegen. In angefügter Datei habe ich sozusagen eine Lifesuchfunktion für ein Wörterbuch gebastelt. Dabei wird der Code immer bei dem OnChange Ereignis der TextBox1 ausgeführt...Leider ist die Funktion ziemlich träge.
Nun wollte ich fragen, ob jemand ein Optierungsvorschlag für mich hätte.
Ich weiß, dass es schneller gehen würde, wenn ich einen zusätzlichen Button einfüge und auf "Suchen" klicke, aber ich wollte im Prinzip genau so eine Lifesuche.
Eventuell hat jemand eine Idde. Ich freue mich auf eure Antworten.
https://www.herber.de/bbs/user/82050.xlsm
Vielen Dank und viele Grüße,
Frank

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchfunktion optimieren
10.10.2012 10:29:48
Frank
Ich habe noch eine Idee dazu.
Vielleicht macht es Sinn die Zeit nach dem Drücken einer Taste zu zählen und erst wenn sagen wir mal 1 Sekunde vorüber ist wird die Call Text_finden Funktion aufgerufen.
Leider habe ich keine Ahnung wie einen Zeitzähler in Verbindung mit Keypress bringen könnte. Könnte mir bitte jemand helfen?
Vielen Dank und viele Grüße,
Frank

AW: Suchfunktion optimieren
10.10.2012 13:30:33
Rudi
Hallo,
da würde ich nur 1 Listbox nehmen und die Daten in Arrays packen.
Sub Text_finden()
Dim Suchtext As String
Dim i As Long
Dim DoE As String
Dim Suchspalte As Integer
Dim Suchergebnis As Integer
Dim arrSuch, arrErg(), lCounter As Long
'Application.ScreenUpdating = False
Suchtext = Sheets(1).TextBox1.Value
DoE = Sheets(1).Cells(1, 8)
If DoE = "Wahr" Then
Suchspalte = 1
Else
Suchspalte = 2
End If
arrSuch = Sheets("Daten").Cells(1, 1).CurrentRegion
ReDim arrErg(1 To 2, 1 To UBound(arrSuch))
For i = 2 To UBound(arrSuch)
Suchergebnis = InStr(1, arrSuch(i, Suchspalte), Suchtext, vbTextCompare)
If Suchergebnis  0 Then
lCounter = lCounter + 1
arrErg(1, lCounter) = arrSuch(i, 1)
arrErg(2, lCounter) = arrSuch(i, 2)
End If
Next i
If lCounter > 0 Then
ReDim Preserve arrErg(1 To 2, 1 To lCounter)
With Sheets("Suchen").ListBox1
.Clear
.ColumnCount = 2
.List = WorksheetFunction.Transpose(arrErg)
End With
Else
Sheets("Suchen").ListBox1.Clear
End If
End Sub

Gruß
Rudi

Anzeige
AW: Suchfunktion optimieren
10.10.2012 14:01:26
TOYY1
Hallo Rudi,
ich habe in der Zeit weiter gemacht und war der Meinung, dass das sozusagen eine andere Anfrage darstellt und deshalb ein neuer Thread.
Vielen Dank zunächst für deine Hilfe, das ist eine sehr elegenate Lösung und funzt super schnell. Wie ich sehe gibts du ein zweispaltiges Array in einer Listbox aus. Ich möchte dennoch gern links Deutsch und rechts Englisch haben. Könntest du mir da nochmal helfen. Ich habe keine Erfahrung mit Arrays.
Vielen Dank und viele Grüße,
Frank

AW: Suchfunktion optimieren
10.10.2012 14:31:36
Rudi
Hallo,
Sub Text_finden()
Dim Suchtext As String
Dim i As Long
Dim DoE As String
Dim Suchspalte As Integer
Dim Suchergebnis As Integer
Dim arrSuch, arrErgDE(), arrErgEN(), lCounter As Long
'Application.ScreenUpdating = False
Suchtext = Sheets(1).TextBox1.Value
DoE = Sheets(1).Cells(1, 8)
If DoE = "Wahr" Then
Suchspalte = 1
Else
Suchspalte = 2
End If
arrSuch = Sheets("Daten").Cells(1, 1).CurrentRegion
ReDim arrErgDE(1 To 1, 1 To UBound(arrSuch))
ReDim arrErgEN(1 To 1, 1 To UBound(arrSuch))
For i = 2 To UBound(arrSuch)
Suchergebnis = InStr(1, arrSuch(i, Suchspalte), Suchtext, vbTextCompare)
If Suchergebnis  0 Then
lCounter = lCounter + 1
arrErgDE(1, lCounter) = arrSuch(i, 1)
arrErgEN(1, lCounter) = arrSuch(i, 2)
End If
Next i
If lCounter > 0 Then
ReDim Preserve arrErgDE(1 To 1, 1 To lCounter)
ReDim Preserve arrErgEN(1 To 1, 1 To lCounter)
With Sheets("Suchen").ListBox1
.Clear
.Column = arrErgDE
End With
With Sheets("Suchen").ListBox2
.Clear
.Column = arrErgEN
End With
Else
Sheets("Suchen").ListBox1.Clear
Sheets("Suchen").ListBox2.Clear
End If
End Sub

Zu deinem 2. Prob habe ich keine Lösung.
Gruß
Rudi

Anzeige
Vielen Dank...
10.10.2012 14:42:25
TOYY1
Hallo Rudi,
der blanke Wahnsinn...funkioniert super :o). Toll, toll, toll.
Eine letzte Frage sei erlaubt: Kann ich die Farbe der selektieretn Zeile eine ListBox ändern?
Userbild

Farbe Markierung anders: Nein. owT
10.10.2012 15:53:09
Rudi

AW: Suchfunktion optimieren
10.10.2012 14:04:08
TOYY1
Ach und noch eine Frage. Manchmal ist die Zeile so lang, das die Breite der ListBox nixht ausreicht. Wie kann ich erreichen, dass in solchen Fällen automatisch eine Scrollleiste eingeblendet wird? Im Prinzip so wie wenn viele Einträge gefunden werden (vertikale Scrollleiste).
Vielen Dank,
Frank
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige