Suche auch in Zellnamen

Forumthread: Suche auch in Zellnamen

19.11.2013 11:00:29

Werner

HAllo!
Habe da mal wieder ein Problemchen.
Ich möchte, dass mit auch die Zellnamen durchsucht und das Ergebnis angezeigt wird.
Hier mein Code (den ich dank eurer Hilfe habe):

Sub finden_HV()
' Startblatt merken, da hier nicht gesucht werden soll
Dim WshShell As Object
Application.ScreenUpdating = False
On Error Resume Next
'Sheets("Suchergebnis").Select
StartBlatt = ActiveSheet.Name
msuch = Range("x1") 'Application.InputBox("Bitte den Suchtext eingeben", , Range("c5"))
If msuch = "" Then GoTo Nachricht
Sheets("Suchergebnis").Visible = True
Sheets("Suchergebnis").Select
mblatt = ActiveSheet.Name
If msuch = False Then
Exit Sub
End If
Nachricht:
If Len(msuch) = 0 Then
MsgBox "Es muss schon ein Suchtext eingegeben werden"
Exit Sub
End If
Range("D1").Value = msuch
Range("A1:C1").ClearContents
Range("A3:G200").ClearContents
Range("A1").Select
Cells(1, 1).Value = "Gefundene Einträge für die Suche nach: " + msuch
Cells(1, 2).Value = "Fundstelle"
' alte vergebene Namen löschen
Z = 1
While Z  Sheets(i).Name Then
If Sheets(i).Visible Then
Worksheets(i).Select
button_true
If IsDate(msuch) Then
Set c = Cells.Find(DateValue(msuch), LookIn:=xlValues, lookat:=xlPart)
Else
If IsNumeric(msuch) Then
Set c = Cells.Find(Val(msuch), LookIn:=xlValues, lookat:=xlPart)
Else
Set c = Cells.Find(msuch, LookIn:=xlValues, lookat:=xlPart)
End If
End If
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Select
' Name für gefundene Zelle vergeben
ActiveWorkbook.Names.Add Name:="Suche" + Trim(Str(S)), RefersTo:="=" +  _
Selection.Address
'If c = "" Then Sheets(mblatt).Cells(Z, 1).Value = msuch
Sheets(mblatt).Cells(Z, 1).Value = c.Value
Sheets(mblatt).Cells(Z, 2).Value = Sheets(i).Name '+ "!" + C.Address
Sheets(mblatt).Cells(Z, 3).Value = ActiveCell.Offset(0, 1).Value
Sheets(mblatt).Cells(Z, 4).Value = ActiveCell.Offset(0, 2).Value
Sheets(mblatt).Cells(Z, 5).Value = ActiveCell.Offset(0, 4).Value
Sheets(mblatt).Cells(Z, 6).Value = ActiveCell.Offset(0, 6).Value
Sheets(mblatt).Cells(Z, 7).Value = Sheets(i).Name + "!" + c.Address
' Hyperlink eintragen in den Eintrag der gefundenen Stelle
Sheets(mblatt).Select
Cells(Z, 1).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=  _
_
"Suche" + Trim(Str(S)), TextToDisplay:=c.text
S = S + 1
Sheets(i).Select
Z = Z + 1
Set c = Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address  firstAddress
End If
button_false
End If
End If
Next
Sheets(StartBlatt).Select
Suchergebnis.Show False
Sheets("Suchergebnis").Visible = False
End Sub

Gruß und Danke schon jetzt!
Werner

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suche auch in Zellnamen

21.11.2013 05:18:03

fcs

AW: Suche auch in Zellnamen

21.11.2013 05:18:03

fcs

Hallo Werner,
grundsätzlich kann man die Namen einer Arbeitsmappe mit einem Makro wie unten auserten/bearbeiten.
Gruß
Franz

'Excel 2010
Sub aaaTest
'Namen auswerten und vergebene Namen löschen die mit "Suche" anfangen
'Sind auch Namen definiert, die keine Zellbereiche Sind, dann muss man _
noch eine Fehlerbehandlung einbauen.
Dim objName As Name
Dim lngZ As Long, rngC As Range
lngZ = 3 '1. Zeile für Eintragen der Ergebnisse
Dim wksErgebnis As Worksheet
Set wksErgebnis = Worksheets("Suchergebnis") 'Tabelle in die Eingetragen werden soll
For Each objName In ActiveWorkbook.Names
With objName
If .Visible = True Then
wksErgebnis.Cells(lngZ, 1) = .Name
Set rngC = .RefersToRange
wksErgebnis.Cells(lngZ, 2) = rngC.Parent.Name  'Tabelle
If rngC.Cells.Count > 1 Then
wksErgebnis.Cells(lngZ, 3) = "mehrere Zellen"
Else
'Zellwert des Namens
wksErgebnis.Cells(Z, 3) = rngC.Value
End If
wksErgebnis.Cells(lngZ, 7) = "'" & .RefersTo
'bestimmte Namen löschen
If Mid(.Name, 1, Len("Suche")) = "Suche" _
And InStr(.Name, wksErgebnis.Name) = 0 Then
.Delete
End If
End If
End With
lngZ = lngZ + 1
Next objName
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Suche auch in Zellnamen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread