Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
788to792
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
788to792
788to792
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Brauche Hilfe

Brauche Hilfe
03.08.2006 16:25:40
Sonja
Hallo Experten,
ich habe nachstehenden Code hier im Forum Dank Eurer Hilfe erhalten:
Option Base 1
Option Compare Text

Sub Suchen_und_anzeigen()
Dim Meldung         As Byte, Pos        As Byte
Dim Schleife        As Byte, y          As Byte
Dim Begriff, Suchen()                   As Variant
Dim Bereich                             As Range
Dim n%, x%, xZelle%, yZelle%
Dim xTabelle$(), Adresse$(), Text$
' Suchbegriff eingeben
Begriff = InputBox _
("Suchwort eingeben." & vbCrLf & _
"Willst Du Abbrechen,einfach Enter drücken", "S U C H M O D U S")
If Begriff = "" Then Exit Sub
Pos = InStr(Begriff, "+")
If Pos Then
ReDim Suchen(2)
Suchen(1) = Left(Begriff, Pos - 1)
Suchen(2) = Right(Begriff, Len(Begriff) - Pos)
Schleife = 2
Else
ReDim Suchen(1)
Suchen(1) = Begriff
Schleife = 1
End If
Application.ScreenUpdating = False
' Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For y = 1 To Schleife
For n = 1 To Sheets.Count
If Sheets(n).Name <> "Auswahltabelle" Then
' Letzte Zelle des Bereiches ermitteln. Diese Zelle wird als Startzelle für
' die Suche deffiniert, da Suche nach dieser Zelle, also in erster Zelle
' des Bereiches beginnt.
'Bereich festlegen
Set Bereich = Worksheets(n).UsedRange
With Worksheets(n).Range(Bereich.Address)
xZelle = .Columns(.Columns.Count).Column
yZelle = .Rows(.Rows.Count).Row
End With
With Sheets(n).Range(Bereich.Address)
Set c = .Find(Suchen(y), After:=Cells(yZelle, xZelle), LookIn:=xlValues)
If Not c Is Nothing Then
ErsteAdresse = c.Address
Do
ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)
xTabelle(x) = Sheets(n).Name
Adresse(x) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Set c = .FindNext(c)
x = x + 1
Loop While Not c Is Nothing And c.Address <> ErsteAdresse
End If
End With
End If
Next n
Next y
Application.ScreenUpdating = True
' 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 leider Nix gefunden", _
vbOKOnly, "G E F U N D E N E   W E R T E")
Exit Sub
Case Else
Meldung = MsgBox("Hurra " & (x - 1) & " Übereinstimmungen gefunden.", _
vbOKOnly, "G E F U N D E N E   W E R T E")
'Tabelle einfügen
'ALTER CODE: Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
On Error Resume Next
With ActiveSheet
.Name = "Startseite"
.[A1] = "Suchergebnis"
For n = 1 To x - 1
.Cells(n + 1, 1) = xTabelle(n)
.Cells(n + 1, 2) = Adresse(n)
Next n
End With
End Select
End Sub

Jetzt ist es so wenn ich nach einem Wort suche:
Ab Spalte A2 erhalte ich als Ergebnis die Blattnamen.
Ab Spalte B2 die genaue Zelle des gesuchten Wortes.
Funktioniert alles bestens nur würde ich da gerne noch eine Kleinigkeit verändern, bzw. nicht ich da ich zu schwach bin für VBA.
Ich hätte nun gerne ab Spalte C2 den genauen Wortlaut des Zellinhaltes stehen. z.B.: ich suche nach dem Wort „Apfel“ dann sollte als Ergebnis z.B.: das kommen
Spalte A2 = Bernd
Spalte D2 = B50
Spalte C2 = Apfelmus
Das von mir angegebene Ergebnis ist natürlich nur als Beispiel gedacht, kann auch anders sein, aber geht ja nicht um das.
Und dann würde ich gerne das Suchwort in Zelle C1 anzeigen lassen, das heisst es müsste etwa dann so aussehen: „Gesuchter Begriff war Apfel“
Ich hoffe meine Probleme sind keine grossen Probleme für Euch da ja ihr die Experten seid.
Ich bin aber sehr zuversichtlich da mir hier bis jetzt immer geholfen werden konnte.
Mit freundlichen Grüssen Sonja

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

Betreff
Datum
Anwender
Anzeige
AW: Brauche Hilfe
03.08.2006 16:34:56
u_
Hallo,
ungetestet:

Sub Suchen_und_anzeigen()
Dim Meldung         As Byte, Pos        As Byte
Dim Schleife        As Byte, y          As Byte
Dim Begriff, Suchen()                   As Variant
Dim Bereich                             As Range
Dim n%, x%, xZelle%, yZelle%
Dim xTabelle$(), Adresse$(), Text$, Inhalt()
' Suchbegriff eingeben
Begriff = InputBox _
("Suchwort eingeben." & vbCrLf & _
"Willst Du Abbrechen,einfach Enter drücken", "S U C H M O D U S")
If Begriff = "" Then Exit Sub
Pos = InStr(Begriff, "+")
If Pos Then
ReDim Suchen(2)
Suchen(1) = Left(Begriff, Pos - 1)
Suchen(2) = Right(Begriff, Len(Begriff) - Pos)
Schleife = 2
Else
ReDim Suchen(1)
Suchen(1) = Begriff
Schleife = 1
End If
Application.ScreenUpdating = False
' Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For y = 1 To Schleife
For n = 1 To Sheets.Count
If Sheets(n).Name <> "Auswahltabelle" Then
' Letzte Zelle des Bereiches ermitteln. Diese Zelle wird als Startzelle für
' die Suche deffiniert, da Suche nach dieser Zelle, also in erster Zelle
' des Bereiches beginnt.
'Bereich festlegen
Set Bereich = Worksheets(n).UsedRange
With Worksheets(n).Range(Bereich.Address)
xZelle = .Columns(.Columns.Count).Column
yZelle = .Rows(.Rows.Count).Row
End With
With Sheets(n).Range(Bereich.Address)
Set c = .Find(Suchen(y), After:=Cells(yZelle, xZelle), LookIn:=xlValues)
If Not c Is Nothing Then
ErsteAdresse = c.Address
Do
ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)
ReDim Preserve Inhalt(x)
xTabelle(x) = Sheets(n).Name
Adresse(x) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Inhalt(x) = c.Value
Set c = .FindNext(c)
x = x + 1
Loop While Not c Is Nothing And c.Address <> ErsteAdresse
End If
End With
End If
Next n
Next y
Application.ScreenUpdating = True
' 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 leider Nix gefunden", _
vbOKOnly, "G E F U N D E N E   W E R T E")
Exit Sub
Case Else
Meldung = MsgBox("Hurra " & (x - 1) & " Übereinstimmungen gefunden.", _
vbOKOnly, "G E F U N D E N E   W E R T E")
'Tabelle einfügen
'ALTER CODE: Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
On Error Resume Next
With ActiveSheet
.Name = "Startseite"
.[A1] = "Suchergebnis"
.[C1] = "Suchbegriff: " & Begriff
For n = 1 To x - 1
.Cells(n + 1, 1) = xTabelle(n)
.Cells(n + 1, 2) = Adresse(n)
.Cells(n + 1, 3) = Inhalt(n)
Next n
End With
End Select
End Sub

Gruß
Lesen gefährdet die Dummheit
Anzeige
AW: Danke an u_, sieht gut aus o.T.
03.08.2006 16:58:02
Sonja

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige