Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
gezielt in 3 Arbeitsblättern suchen VBA?
Kay
Gute Morgen,
habe eine Userform mit vielen Feldern etc. - klappt alles super. Nun hab ich vor, Datensätze auch wieder bearbeiten zu lassen. Per Suche soll der User die Möglichkeit haben, nach einem Datensatz gezielt zu suchen, den er bearbeiten möchte.
Wie kann ich die Suche ermöglichen ?
Dachte an eine Userform "Suche", mit einer Textbox für den Suchbegriff und einer Listbox, wo alle gefundenen Zeilen angezeigt werden, in denen der Suchbegriff gefunden wurde.
Wichtig, möchte "Nur" in 3 von den 8 Arbeitsblättern suchen lassen sowie eine * Suche ermöglichen, falls ein Name nicht mehr genau gewußt wird. Achja, die Suche muss über die 3 Datentabellen gehen, aber die Tabellenüberschriften sollten nicht angezeigt werden, bzw. bei der Suche ausgeschlossen werden. Hierzu habe ich die Datenbereiche mit Dynamischen Namen versehen - dachte das könnte helfen - Suche innerhalb der Namen ?!
Hat jemand einen Ansatz - lässt sich meine Anforderung so umsetzen ?
Vielen Dank !
Gruß
Kay

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

Betreff
Benutzer
Anzeige
AW: gezielt in 3 Arbeitsblättern suchen VBA?
13.07.2009 12:25:43
Martin
Hallo Kay,
die gute Nachricht zu Beginn: Ja, das ist möglich! Genau das von Dir beschrieben Vorhaben habe ich bereits (sogar mit 10 Tabellenblättern) umgesetzt. Die schlechte Nachricht: Es ist schon relativ anspruchsvoll.
Einige Tipps zur Umsetzung:
- Gib jedem Datensatz eine individuelle ID (wie in einer Datenbank)
- Sammle Dein Suchergebnis in einem Array und übergib dieses an die Listbox mit den Treffern
Ich gebe Dir meinen Code, der Dir bestimmt sehr weiterhelfen wird:
'-------------------------------------------------------------------------------------------------------------
' Suche starten
'-------------------------------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
'Bei ScreenUpdating = False flimmern
If ComboBox1 = "" Then ComboBox1 = "*"
'Stnr.-Erkennung -> Keine partiellen Treffer zulassen
If Len(ComboBox1) = 1 Then 'damit manuell umschaltbar
If IsNumeric(ComboBox1) = True Then OptionButton4 = True Else OptionButton1 = True
End If
ListBox1.Clear 'Listbox leeren
Dim Suchbeginn, Suchende
If CheckBox1 = False Then 'Alle Protokolle durchsuchen
Suchbeginn = 1
Suchende = 10
Else
Suchbeginn = ComboBox2.ListIndex + 1
Suchende = ComboBox3.ListIndex + 1
End If
'    Suchbereich festlegen
Dim Suchart 'Nur ganzen Inhalt in Zellen suchen oder Fragmentfunde zulassen
If CheckBox2 = False Then Suchart = xlPart Else Suchart = xlWhole
Dim TrefferArr As Variant
Dim Spalten As Integer
ReDim TrefferArr(0 To 8, 1 To 1)
For i = Suchbeginn To Suchende 'Protkolle, in denen gesucht wird
'i = Protokoll index
'Wenn Protokoll unter "Einstellungen" angeklickt ist
If Sheets("Einstellungen").Cells(i + 5, 11) = "Wahr" Then
If Sheets("Wettbewerb " & i).[B7]  "" Then 'Wenn mindestens 1 Eintrag im  Protokoll  _
ist
'Suchbereiche definieren (Vollsuche, Name, Vorname oder Startnr)
Dim Suchbereich As Range
If OptionButton1 = True Then 'Volltext
Set Suchbereich = Sheets("Wettbewerb " & i).Range("Bereich5")
ElseIf OptionButton2 = True Then 'Name
Set Suchbereich = Sheets("Wettbewerb " & i).Range("Nachname")
ElseIf OptionButton3 = True Then 'Vorname
Set Suchbereich = Sheets("Wettbewerb " & i).Range("Vorname")
ElseIf OptionButton4 = True Then 'Startnummer
Set Suchbereich = Sheets("Wettbewerb " & i).Range("startnummern")
Else: MsgBox "Es ist ein Fehler in der Suchbereich-Festlegung aufgreten!", vbOKOnly  _
+ vbExclamation, "Fehler in Suchfunktion"
End If
'    Suchen und Treffer auflisten
Dim c, firstAddress, lastAddress, Zeit
Dim Treffer As Boolean
With Suchbereich
Set c = .Find(ComboBox1, LookIn:=xlFormulas, lookat:=Suchart) 'muss auf LookIn:= _
xlFormulas stehen, sonst gehen ausgeblendete Zellen nicht
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Row & c.Worksheet.Name  lastAddress And Not Application. _
Intersect(Sheets("Wettbewerb " & i).Cells(c.Row, c.Column), Sheets("Wettbewerb " & i).Range("Nachname,Vorname,Verein,startnummern")) Is Nothing Then 'Jahrgang kann sich mit Stnr überschneiden
Zeit = c.EntireRow.Cells(1, Sheets("Wettbewerb " & i).Range(" _
Endzeit").Column) 'Endzeit
'If Zeit >= 1 Then Zeit = ""
Treffer = False
'Alle/Finisher/DNF
If ComboBox4.ListIndex = 0 Or (ComboBox4.ListIndex = 1 And Zeit  0 Then
If Treffer = True And c.EntireRow.Cells(1, Sheets(" _
Wettbewerb " & i).Range("SW" & ComboBox5.ListIndex).Column) = "" Then Treffer = False
End If
End If
If Treffer = True Then
If TrefferArr(0, 1)  "" Then ReDim Preserve TrefferArr(0 To  _
UBound(TrefferArr, 1), 1 To UBound(TrefferArr, 2) + 1)
TrefferArr(0, UBound(TrefferArr, 2)) = c.EntireRow.Cells(1,  _
Sheets("Wettbewerb " & i).Range("Nachname").Column) 'Nachname
TrefferArr(1, UBound(TrefferArr, 2)) = c.EntireRow.Cells(1,  _
Sheets("Wettbewerb " & i).Range("Vorname").Column) 'Vorname
TrefferArr(2, UBound(TrefferArr, 2)) = c.EntireRow.Cells(1,  _
Sheets("Wettbewerb " & i).Range("Verein").Column) 'Verein
TrefferArr(3, UBound(TrefferArr, 2)) = c.EntireRow.Cells(1,  _
Sheets("Wettbewerb " & i).Range("NameAK").Column) 'AK
TrefferArr(4, UBound(TrefferArr, 2)) = c.EntireRow.Cells(1,  _
Sheets("Wettbewerb " & i).Range("startnummern").Column) 'Startnr.
TrefferArr(5, UBound(TrefferArr, 2)) = i 'Wettbewerb
TrefferArr(6, UBound(TrefferArr, 2)) = c.EntireRow.Cells(1,  _
Sheets("Wettbewerb " & i).Range("Jahrgang").Column) 'Jahrgang
TrefferArr(7, UBound(TrefferArr, 2)) = c.EntireRow.Cells(1,  _
Sheets("Wettbewerb " & i).Range("Geschlecht").Column) 'w/m
TrefferArr(8, UBound(TrefferArr, 2)) = Zeit 'Endzeit
End If
lastAddress = c.Row & c.Worksheet.Name
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address  firstAddress
End If
End With
End If
End If
Next i
'Array transponiert an Listbox übergeben
Dim TrefferArr2()
If UBound(TrefferArr, 2) = 1 Then 'Wenn nur 1 Teilnehmer
ReDim TrefferArr2(1 To 1, 0 To UBound(TrefferArr, 1))
For j = 0 To UBound(TrefferArr, 1)
TrefferArr2(1, j) = TrefferArr(j, 1)
Next j
Else: TrefferArr2 = Application.Transpose(TrefferArr)
End If
If TrefferArr(0, 1)  "" Then ListBox1.List() = TrefferArr2
Label4.Caption = "Suchergebnis:   " & ListBox1.ListCount & " Treffer"
Label4.Visible = True
ComboBox1.SetFocus
ComboBox1.SelStart = Len(ComboBox1)
ComboBox1.SelLength = Len(ComboBox1)
If ListBox1.ListCount > 0 Then
ListBox1.ListIndex = 0 'Ersten Treffer markieren
Label15.Enabled = True
Else
Label15.Enabled = False
End If
End Sub
Viele Grüße
Martin
Anzeige
AW: gezielt in 3 Arbeitsblättern suchen VBA?
13.07.2009 20:37:13
Kay
Hallo Martin,
...sorry, dass ich mich erst jetzt bedanke für Deine Antwort. Ich werde Sie mir jetzt noch genauer anschauen und spätestens morgen auf meiner Version probieren. Hättest Du evtl. eine Musterdatei für mich - damit ich den Code besser nachvollziehen kann ?!
Gruß und vielen Dank !
Kay

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige