Suchen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:


Excel-Version: 2000
  • Suchen von TOM vom 12.04.2002 - 17:06:21
nach unten

Betrifft: Suchen
von: TOM
Geschrieben am: 12.04.2002 - 17:06:21

Ich möchte gerne ein Begriff über mehrer Blätter suchen.Wenn ein Begriff gefunden wird in die Textbox übernehmen. Wenn mehrere gleich Begriffe gefunden werden, alle in eine Listbox schreiben zum auswählen und dann wieder einblenden in einer Textbox.
Wer kann mir da helfen.
Besten Dank TOM

nach oben   nach unten

Re: Suchen
von: MRR
Geschrieben am: 12.04.2002 - 17:59:41

Ein Lösung für ein ähnliches Problem habe ich am Dienstag oder Mittwoch mit den entsprechenden Code hier gepostet. Hilft Dir das weiter???
Matthias

nach oben   nach unten

Re: Suchen
von: GraFri
Geschrieben am: 12.04.2002 - 18:22:11

Hallo

Hier ein Beispielcode. Passe ihn entsprechend an.
--------------------------------------------------------

'Erstelle in der Tabelle ein Commandbutton (cmdStart)
'eine Textfeld (TxAnzeige) und ein Listenfeld (LbAnzeige)

Option Base 1
Option Compare Text

Dim xTabelle() As String
Dim xAdresse() As String
Dim xInhalt() As Variant

Sub Suchen_und_anzeigen()
Dim n%, x%, xZelle%, yZelle%
Dim Meldung As Byte
Dim Bereich As String
Dim Suchen As Variant

'Bereich festlegen
Bereich = Application.InputBox("Bitte den zu durchsuchenden Bereich" & vbCrLf & _
"eingeben (z.B.: A1:T200)", "Bereich festlegen", "A1:T200", 8)
' Suchbegriff eingeben
Suchen = InputBox("Bitte den zu suchenden Wert hier eingeben." & vbCrLf & _
"ENTER ohne Wert = Abbruch", "S U C H M O D U S")
If Suchen = "" Then Exit Sub

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' letzte Zelle im Bereich ermitteln
With Worksheets(1).Range(Bereich)
xZelle = .Columns(.Columns.Count).Column
yZelle = .Rows(.Rows.Count).Row
End With

' Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For n = 1 To Sheets.Count
With Sheets(n).Range(Bereich)
Set c = .Find(Suchen, After:=Cells(yZelle, xZelle), LookIn:=xlValues)
If Not c Is Nothing Then
ErsteAdresse = c.Address
Do
ReDim Preserve xAdresse(x)
ReDim Preserve xTabelle(x)
ReDim Preserve xInhalt(x)
'In welchem Tabellenblatt gefunden
xTabelle(x) = Sheets(n).Name
'Adresse der Zelle
xAdresse(x) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)
'Inhalt dieser Zelle
xInhalt(x) = Sheets(xTabelle(x)).Range(xAdresse(x)).Value

Set c = .FindNext©
x = x + 1
Loop While Not c Is Nothing And c.Address <> ErsteAdresse
End If
End With
Next n

' Anzeige der Suchergebnisse
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

' Die Anzahl der gefundenen Werte ist (x - 1), wenn keiner
' gefunden wurde dann ist x = 1
Select Case x
Case 1
Meldung = MsgBox("Es wurde kein übereinstimmender Wert gefunden", _
vbOKOnly, "G E F U N D E N E W E R T E")
Case 2
With LbAnzeige
.Clear
.AddItem xTabelle(n) & " in der Zelle: " & xAdresse(n)
End With
Case Else
With LbAnzeige
.Clear
For n = 1 To x - 1
.AddItem xTabelle(n) & " in der Zelle: " & xAdresse(n)
Next n
.ListIndex = 0
End With
End Select

End Sub

'Listenfeld in der Tabelle mit dem Namen 'LbAnzeige'
Private Sub LbAnzeige_Click()
On Error Resume Next
TxAnzeige = xInhalt(LbAnzeige.ListIndex + 1)
End Sub

'Button in der Tabelle mit dem Namen 'CmdStart'
Private Sub CmdStarten_Click()
Call Suchen_und_anzeigen
End Sub
--------------------------------------------------------

Bei weiteren Fragen mailen.

mfg, GraFri

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Suchen"