Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1236to1240
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

Hilfe bei meiner Suchmaschine

Hilfe bei meiner Suchmaschine
coolhonk
Hallo
Erst mal, ich bin ein totaler Noob in Sachen Excel! Auf jeden Fall musste ich nun eine Tabelle erstellen mit mehreren Spalten. Dabei sollte ich zum Schluss noch so eine Art Suchmaschine dazu bereitstellen. Nun hab ich genau so was wie ich es brauche im Internet gefunden. Mein Problem dabei ist jedoch , wenn ich mehrere Suchbegriffe eingebe, sucht er nur den ersten. Ich will jedoch das ich nach mehreren Sachen gleichzeitig suchen kann. Außerdem hätte ich gern das die Groß- und Kleinschreibung nicht mehr beachtet wird. Könntet ihr mir bitte sagen was ich umschreiben muss, bzw. kann? Es ist wirklich dringend!!
Ich danke euch allen schon einmal in Voraus!!!!
__________________________________________________________________________
Option Explicit
Dim objDic As Object
Private Sub CommandButton1_Click()
Dim arListe As Variant ' hier werden die gefundenen Zeilen eingetragen
objDic.RemoveAll
ListBox1.Clear
If Len(TextBox1.Value) Then objDic.Add 1, TextBox1.Value ' suche in Spalte 1 nach TextBox1
If Len(TextBox2.Value) Then objDic.Add 3, TextBox2.Value ' suche in Spalte 3 nach TextBox2
If Len(TextBox3.Value) Then objDic.Add 6, TextBox3.Value ' suche in Spalte 6 nach TextBox3
If Len(TextBox4.Value) Then objDic.Add 7, TextBox4.Value ' suche in Spalte 7 nach TextBox3
If SuchMich(Tabelle1.Range("A2:G10"), arListe) Then ListBox1.List = arListe
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub ListBox1_Click()
End Sub

Private Sub UserForm_Initialize()
Set objDic = CreateObject("scripting.dictionary")
End Sub

Private Sub UserForm_Terminate()
objDic.RemoveAll
Set objDic = Nothing
End Sub

Private Function SuchMich(rngSrc As Range, arGefunden As Variant) As Boolean
Dim col As New Collection ' Liste mit Zeilennummern der Fundstellen
Dim arSrc As Variant ' rngSrc als Array
Dim i As Long ' Zeilenzähler
Dim j As Integer ' Spaltenzähler
Dim varItem As Variant ' zum Durchlaufen des Dictionaries
Dim bolFound As Boolean ' Flag für alle Suchkriterien erfüllt
arSrc = rngSrc
For i = 1 To UBound(arSrc)
bolFound = True
For Each varItem In objDic
If InStr(1, CStr(arSrc(i, varItem)), objDic(varItem)) = 0 Then
'If CStr(arSrc(i, varItem))  objDic(varItem) Then
bolFound = False
Exit For
Else
bolFound = True
Exit For
End If
Next
If bolFound Then col.Add i, CStr(i) ' Falls alle Suchkriterien erfüllt sind diese Zeilennummer  _
merken
Next
If col.Count Then
ReDim arGefunden(1 To col.Count, 1 To 7)
For i = 1 To col.Count
For j = 1 To 7 ' einfach die Spalten 1...7 kopieren
arGefunden(i, j) = arSrc(col(i), j)
Next
Next
SuchMich = True
End If
Set col = Nothing
End Function

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Hilfe bei meiner Suchmaschine
08.11.2011 15:42:12
coolhonk
Es tut mir leid, jedoch ist mein Anliegen sehr dringend und deswegen musste ich zu diesem Mittel greifen. Es wird in Zukunft nicht wieder vorkommen.
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige