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

Name des Tabellenblatts noch angeben

Name des Tabellenblatts noch angeben
Pascal
Guten Tag allerseits
Mittels einer Schaltfläche (diese steht auf einer UserForm) durchsuche ich eine Datenbank nach diversen Begriffen / Texten.
Den Makro-Code – oder zumindst Teile davon - für diese geniale Such-Funktion lieferte mir vor einigen Jahren mal jemand hier aus dem Forum.
Dieses Makro listet dann alle gefundenen Datensätze (die in der ganzen Datenbank, verteilt auf verschiedene Tabellenblätter verstreut sind) tabellarisch auf.
Der Code hinter der Such-Schaltfläche ist folgender:
Private Sub CommandButton1_Click()
'On Error Resume Next
Dim wb As Workbook, WS_Suche As Worksheet, oWS As Worksheet, _
rngUnion As Range, rngFund As Range
Dim strErste$, strSuchBegriff$
Dim MaxRow As Long, xCol As Long
'Hinweis: da
'Dim strErste$ = Dim strErste As String
'muß bei der weiteren Verwendung der Variable 'strErste' das $-Zeichen nicht mehr geschrieben  _
werden
Set wb = ThisWorkbook
'Tabelle für die Auflistung
Set WS_Suche = wb.Worksheets("Suche")
WS_Suche.UsedRange.Clear
strSuchBegriff = Such_Formular.TextBox1.Text
If StrPtr(strSuchBegriff) = 0 Then
Exit Sub
End If
MaxRow = 1
Sheets("Suche").UsedRange.Clear
For Each oWS In ThisWorkbook.Worksheets
If oWS.Name  WS_Suche.Name Then
'es wirde die Suchoption xlByRows in xlByColumns geändert, damit die Zeilen _
in der Reihenfolge sind
Set rngFund = oWS.UsedRange.Find(strSuchBegriff, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not rngFund Is Nothing Then
'letzte Spalte in der gefundenen Zeile ermitteln
xCol = oWS.Cells(rngFund.Row, oWS.Columns.Count).End(xlToLeft).Column
'nicht die ganze Zeile, sondern nur die Zellen mit Inhalt in der Zeile übernehmen
Set rngUnion = rngFund.EntireRow
strErste = rngFund.Address
Set rngFund = oWS.UsedRange.FindNext(rngFund)
Do While strErste  rngFund.Address
xCol = oWS.Cells(rngFund.Row, oWS.Columns.Count).End(xlToLeft).Column
Set rngUnion = Union(rngUnion, rngFund.EntireRow)
Set rngFund = oWS.UsedRange.FindNext(rngFund)
Loop
End If
If Not rngUnion Is Nothing Then
For Each rngUnion In rngUnion.Areas
rngUnion.Copy WS_Suche.Cells(MaxRow, 1)
MaxRow = MaxRow + rngUnion.Rows.Count
Next rngUnion
Set rngUnion = Nothing
End If
End If
Next oWS
Set rngFund = Nothing
Set rngUnion = Nothing
Set oWS = Nothing
If MaxRow > 1 Then
Such_Formular.CommandButton3.Visible = True
Such_Formular.CommandButton1.Visible = False
Else
Such_Formular.CommandButton3.Visible = False
Such_Formular.CommandButton1.Visible = True
End If
Such_Formular.TextBox1.Text = ""
End Sub

Nun möchte ich diesen Code so erweitern, dass er mir hinter (oder vor) den gefundenen Datensätzen auch noch der Name des Tabellblatts hinschreibt, auf welchem der entsprechende Datensatz gefunden wurde.
Doch leider brachte ich das bisher nicht hin.
Versuchte schon mehrmals vergeblich über eine Art Worksheets.name ….
Ich hoffe sehr, dass mir jemand hier weiterhelfen kann.
Im voraus HERZLICHEN DANK !!!

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Name des Tabellenblatts noch angeben
30.06.2011 12:50:30
René
Anbei mal ein Beispiel wie ich das gelöst habe. Vielleicht hilft es Dir
Sub Schaltfläche433_Klicken()
Dim c               As Range
Dim Suchwert        As Variant
Dim ws              As Worksheet
Dim ersterFundort   As String
Dim i               As Integer, z As Long
z = 1
Application.ScreenUpdating = False
Suchwert = InputBox("Suchbegriff", "Suchbegriff")
If Suchwert = "" Then Exit Sub
For Each ws In Sheets
If ws.Name = "Suchergebnis" Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
Set ws = ActiveSheet
ws.Name = "Suchergebnis"
ws.Cells(1, 1).Value = "Suchergebnis"
ws.Cells(1, 2).Value = "im Tabellenblatt"
ws.Cells(1, 3).Value = "Zelladresse"
ws.Cells(1, 4).Value = "PR-Nummer"
ws.Cells(1, 5).Value = "Eigenschaft"
ws.Cells(1, 6).Value = "Nummer der Familie"
ws.Cells(1, 7).Value = "Familie"
'sucht in Tabelle 1 bis 180
For i = 1 To 180
'würde in allen Tabellen suchen
'For i = 1 To Sheets.Count - 1
Set c = Sheets(i).Cells.Find(what:=Suchwert, lookat:=xlValue)
If Not c Is Nothing Then
Do Until c Is Nothing Or c.Address = ersterFundort
If ersterFundort = "" Then ersterFundort = c.Address
z = z + 1
With ws
.Cells(z, 3).Value = c.Address(False, False)
.Cells(z, 2).Value = Sheets(i).Name
.Hyperlinks.Add Anchor:=.Cells(z, 1), Address:="", _
SubAddress:=Sheets(i).Name & "!" & c.Address(False, False), _
TextToDisplay:=CStr(c)
'Spalten C bis D der gefundenen Zeile kopieren
With Sheets(i)
.Range(.Cells(c.Row, 1), .Cells(c.Row, 4)).Copy _
Destination:=ws.Cells(z, 4)
End With
End With
Set c = Sheets(i).Cells.FindNext(c)
Loop
End If
Set c = Nothing
ersterFundort = ""
Next
If z = 1 Then MsgBox Suchbegriff & "Suchbegriff wurde nicht gefunden.", vbInformation, " _
Suchergebnis nicht erfolgreich"
ws.Columns.AutoFit
End Sub

Anzeige
AW: Name des Tabellenblatts noch angeben
30.06.2011 14:36:55
Pascal
Sali René
Danke herzlich für diesen Vorschlag. Diesen werde ich mal etwas näher anschauen und ...
natürlich mal etwas austesten.
AW: Name des Tabellenblatts noch angeben
30.06.2011 12:51:05
Rudi
Hallo,
so?
          If Not rngUnion Is Nothing Then
ws_Suche.Cells(maxRow, 1) = oWS.Name
maxRow = maxRow + 1
For Each rngUnion In rngUnion.Areas
rngUnion.Copy ws_Suche.Cells(maxRow, 1)
maxRow = maxRow + rngUnion.Rows.Count
Next rngUnion
Set rngUnion = Nothing
End If

Gruß
Rudi
AW: Name des Tabellenblatts noch angeben
30.06.2011 14:35:46
Pascal
Sali !
Herzlichen Dank schon mal für diesen Lösungsvorschlag.
ich werde diesen gleich mal austesten.
AW: Name des Tabellenblatts noch angeben
30.06.2011 14:50:08
Pascal
Also... dieser Code hier macht ganz genau, was ich suchte ! HERZLICHEN DANK dafür.
Nun muss ich nur noch eine Möglichkeit finden, dass mir die Zeile (in welcher jetzt dank diesem Code der Namen des Tabellenblatts ausgegeben wird) - fettgeschrieben und andersfarbig dargestellt wird.
Oder wüsstest Du dies evt. auch noch gleich ? ;-))
Grüsse: Pascal
Anzeige
AW: Name des Tabellenblatts noch angeben
30.06.2011 15:32:45
Rudi
Hallo,
klar weiß ich das.
          If Not rngUnion Is Nothing Then
With ws_Suche.Cells(maxRow, 1)
.Value = oWS.Name
.Interior.Color = RGB(255, 0, 0)
With .Font
.Color = RGB(255, 255, 255)
.Bold = True
End With
End With
maxRow = maxRow + 1
For Each rngUnion In rngUnion.Areas
rngUnion.Copy ws_Suche.Cells(maxRow, 1)
maxRow = maxRow + rngUnion.Rows.Count
Next rngUnion
Set rngUnion = Nothing
End If

Gruß
Rudi
AW: Name des Tabellenblatts noch angeben
30.06.2011 15:46:10
Pascal
Sowas nennt man GENIE !!!!
HERZLICHEN DANK !!!!!

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige