Ich möchte bei einer VBA statt der absoluten Zellenposition den Inhalt dieser Zelle angezeigt bekommen. Kann den Code auch posten.
Hundetrtausend Dank.
vielleicht reicht Dir Zelle.Value, andernfalls doch besser den Code posten.
Gruß
Peter
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$
'Bereich festlegen
Set Bereich = Application.InputBox _
("Bitte den zu durchsuchenden Bereich eingeben " & vbCrLf & _
"(z.B.: A1:A200),oder markieren Sie den Such-" & vbCrLf & _
"bereich im Tabellenblatt.", "Bereich festlegen", "A1:A200", Type:=8)
' Suchbegriff eingeben
Begriff = InputBox _
("Bitte den zu suchenden Wert eingeben. Sollen 2 Werte" & vbCrLf & _
"gleichzeitig gesucht werden, dann mit Zeichen + " & vbCrLf & _
"voneinander trennen (z.B.: Summe+die)." & vbCrLf & vbCrLf & _
"ENTER ohne Wert = Abbruch", "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
' 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.
With Worksheets(1).Range(Bereich.Address)
xZelle = .Columns(.Columns.Count).Column
yZelle = .Rows(.Rows.Count).Row
End With
' Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For y = 1 To Schleife
For n = 1 To Sheets.Count
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
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 kein übereinstimmender Wert gefunden", _
vbOKOnly, "G E F U N D E N E W E R T E")
Case Else
'Tabelle einfügen
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
On Error Resume Next
With ActiveSheet
.Name = "Suchergebnis"
.[A1] = "Tabelle"
.[B1] = "Zelle"
For n = 1 To x - 1
.Cells(n + 1, 1) = xTabelle(n)
.Cells(n + 1, 2) = Adresse(n)
Next n
End With
End Select
versuch es mal so:
Gruß
Peter
Ach ja. wenn statt der Zelle die Zeile angezeigt werden soll,
was müsste ich dann noch umstellen ?
Bin leider kein Profi, arbeite aber hart dran...
.Cells(n + 1, 2) = Worksheets(xTabelle(n)).Range(Adresse(n)).Row
Und falls Du auch noch die Spalte möchtest dann ersetze Row durch Column.
Gruß
Peter
Mann, ich nerve bestimmt, oder ?
meinst Du mit "ganzen Zeileninhalt" die komplette Zeile? Das kann nicht gehen da ab Spalte B sich keine komplette Zeile einfügen läßt.
Gruß
Peter
hatte mich nur mit Deinem Detailproblem beschäfttigt. Für das, was Du jetzt möchtest muss ich mich in den Code einlesen. Werde das am Wochenende machen.
Gruß
Peter
PS: für einen, der lernen will ein ziemlich komplexer Code!
versuch es mal so:
Gruß
Peter