Office: Suchfunktion für Textfelder VBA (Textfeldsuche)

Helfe beim Thema Suchfunktion für Textfelder VBA (Textfeldsuche) in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Code: Sub Suche() Dim shaShape As Shape Dim varFrage As Variant Dim lngZaehler As Long varFrage = Application.InputBox("Bitte Suchbegriff eingeben",... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Falke89, 29. Juni 2015.

Seite 2 von 3

Beverly Erfahrener User

Suchfunktion für Textfelder VBA (Textfeldsuche)

Code:

Sub Suche()
Dim shaShape As Shape
Dim varFrage As Variant
Dim lngZaehler As Long
varFrage = Application.InputBox("Bitte Suchbegriff eingeben", "Suche", , , , , , 2)
If varFrage "Falsch" And varFrage False Then
For Each shaShape In ActiveSheet.Shapes
If shaShape.Type = 17 Then
If shaShape.DrawingObject.Text Like "*" & varFrage & "*" Then
Application.Goto reference:=shaShape.TopLeftCell, Scroll:=True
With shaShape
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
ElseIf shaShape.Type = 6 Then
For lngZaehler = 1 To shaShape.GroupItems.Count
If shaShape.GroupItems(lngZaehler).Type = 17 Then
If shaShape.GroupItems(lngZaehler).DrawingObject.Text Like "*" & varFrage & "*" Then
Application.Goto reference:=shaShape.GroupItems(lngZaehler).TopLeftCell, Scroll:=True
With shaShape.GroupItems(lngZaehler)
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
End If
Next lngZaehler
End If
Next shaShape
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Einen Teil des Codes habe ich entfernt da ich festgeestellt habe, dass er die Schalter ganz oben links betrifft, die ja nicht verändert werden sollen.

Beverly, 2. Juli 2015

#16
FALKE89

Falke89

Vielen vielen Dank Beverly, das ist zu 100% genau das was ich brauche.

Könntest du mir bitte noch eine Ergänzung schicken, dass die Formatierung zum Schluss bzw. bei einer neuen Suche wieder verschwindet.
(Sonst ist bei mehreren Suchanfragen irgendwann alles rot *grins )

Nach deiner super Leistung denke ich, dass das auch kein Problem mehr ist. *boah

Vielen Dank nochmal.

Gruß
Manuel

Falke89, 2. Juli 2015

#17
Beverly Erfahrener User

Hi Manuel,

Code:

Sub Suche()
Dim shaShape As Shape
Dim varFrage As Variant
Dim lngZaehler As Long
Dim arrShapes()
Dim lngShapes As Long
varFrage = Application.InputBox("Bitte Suchbegriff eingeben", "Suche", , , , , , 2)
If varFrage "Falsch" And varFrage False Then
For Each shaShape In ActiveSheet.Shapes
If shaShape.Type = 17 Then
If shaShape.DrawingObject.Text Like "*" & varFrage & "*" Then
ReDim Preserve arrShapes(0 To 1, 0 To lngShapes)
arrShapes(0, lngShapes) = shaShape.Name
arrShapes(1, lngShapes) = shaShape.DrawingObject.Font.Color
lngShapes = lngShapes + 1
Application.Goto reference:=shaShape.TopLeftCell, Scroll:=True
With shaShape
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
ElseIf shaShape.Type = 6 Then
For lngZaehler = 1 To shaShape.GroupItems.Count
If shaShape.GroupItems(lngZaehler).Type = 17 Then
If shaShape.GroupItems(lngZaehler).DrawingObject.Text Like "*" & varFrage & "*" Then
ReDim Preserve arrShapes(0 To 1, 0 To lngShapes)
arrShapes(0, lngShapes) = shaShape.GroupItems(lngZaehler).Name
arrShapes(1, lngShapes) = shaShape.GroupItems(lngZaehler).DrawingObject.Font.Color
lngShapes = lngShapes + 1
Application.Goto reference:=shaShape.GroupItems(lngZaehler).TopLeftCell, Scroll:=True
With shaShape.GroupItems(lngZaehler)
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
End If
Next lngZaehler
End If
Next shaShape
End If
For lngZaehler = 0 To UBound(arrShapes(), 2)
With ActiveSheet.Shapes(arrShapes(0, lngZaehler))
.Line.Visible = msoFalse
.DrawingObject.Font.Color = arrShapes(1, lngZaehler)
End With
Next lngZaehler
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Beverly, 2. Juli 2015

#18
FALKE89

Falke89

Suchfunktion für Textfelder VBA (Textfeldsuche)

Hi Beverly,

da sehe ich jetzt leider keinen Unterschied, bei mehrfacher Suche wird dann immer mehr rot.

Evtl. könnte man das einfacher mit einem 2. Button machen, bspw. "Suchergebniss zurücksetzen"!?

Es sollen dann also alle Formkonturen wieder verschwinden und die Schrift bei den schwarzen Feldern wieder weiß und die restlichen schwarz werden. *Smilie

Falke89, 2. Juli 2015

#19
FALKE89

Falke89

Ich hätte da an sowas gedacht:

Code:

Sub Suchergebnis_zurücksetzen()
'
' Suchergebnis_zurücksetzen Makro
'

'
ActiveSheet.Shapes.Range(Array("TextBox 12")).Select
With Selection.ShapeRange.Line
.Visible = msoFalse
End With
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
Range("A1").Select
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Allerdings habe ich damit jetzt nur eine TextBox angesprochen *tongue.gif*

Falke89, 2. Juli 2015

#20
Beverly Erfahrener User

Hi,

der Code macht folgendes: zuerst werden alle Elemente gesucht und die Rahmen sowie der betreffende Texteil rot gefärbt. Gleichzeitig wird der Name des betreffenden Elementes sowie seine Schriftfarbe in ein Array geschrieben. Am Ende des Codes wird das Array in einer Schleife durchlaufen und alle Elemente, die ins Array eigentragen wurden, wieder zurückgesetzt in den Urzustand. Die Schriftfarbe kann nicht einfach auf Schwarz (bzw. automatisch) gesetzt werden, weil es auch Elemente gibt, deren Schriftfarbe Weiß ist - deshalb der "Umweg" über das Array.
Wenn du natürlich bereits Elemente hast, die eingefärbt wurden, dann werden diese logischerweise nicht mit zurückgesetzt, da sie ja nicht in dem Array stehen - bevor der Code bei dir also tatsächlich die gewünschten Effekte hat, musst du alle Elemente erst einmal zurücksetzen.

Beverly, 2. Juli 2015

#21
FALKE89

Falke89

Hi nochmal,

wie kann ich dann die Elemente ansprechen, und die Schriftfarbe und Rahmenfarbe zurücksetzen?

Bzw. kann man dann nicht die jeweiligen Typen mit schwarzer Schrift und die mit weißer Schrift ansprechen?

Ich könnte bei den Elementen mit weißer Schrift die Schriftfarbe auch auf schwarz ändern und den Hintergrund bspw. auf Blau, falls das die Lösung einfacher machen sollte!?

Danke für deine tolle Unterstützung!!!

Gruß und sonniges Wochenende *Sun
Manuel

Falke89, 3. Juli 2015

#22
Beverly Erfahrener User

Suchfunktion für Textfelder VBA (Textfeldsuche)

Hi Manuel,

das verstehe ich jetzt gerade nicht - der Code setzt doch die Farben wieder zurück.

Beverly, 3. Juli 2015

#23
XLPH

xlph

Hallo Falke 89,

wie gefällt dir folgende Version...

xlph, 3. Juli 2015

#24
Beverly Erfahrener User

Hi Manuel,

ich habe gerade festgestellt, dass einige Elemente einen Standardrahmen haben - wenn du dich darauf beziehst, dass diese auch zurückgesetzt werden müssen. Hier der geänderte Code (Änderungen sind rot markiert):

Code:

Sub Suche()
Dim shaShape As Shape
Dim varFrage As Variant
Dim lngZaehler As Long
Dim arrShapes()
Dim lngShapes As Long
varFrage = Application.InputBox("Bitte Suchbegriff eingeben", "Suche", , , , , , 2)
If varFrage "Falsch" And varFrage False Then
For Each shaShape In ActiveSheet.Shapes
If shaShape.Type = 17 Then
If shaShape.DrawingObject.Text Like "*" & varFrage & "*" Then
ReDim Preserve arrShapes(0 To 3, 0 To lngShapes)
arrShapes(0, lngShapes) = shaShape.Name
arrShapes(1, lngShapes) = shaShape.DrawingObject.Font.Color
arrShapes(2, lngShapes) = shaShape.Line.ForeColor
arrShapes(3, lngShapes) = shaShape.Line.Visible
lngShapes = lngShapes + 1
Application.Goto reference:=shaShape.TopLeftCell, Scroll:=True
With shaShape
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
ElseIf shaShape.Type = 6 Then
For lngZaehler = 1 To shaShape.GroupItems.Count
If shaShape.GroupItems(lngZaehler).Type = 17 Then
If shaShape.GroupItems(lngZaehler).DrawingObject.Text Like "*" & varFrage & "*" Then
ReDim Preserve arrShapes(0 To 3, 0 To lngShapes)
arrShapes(0, lngShapes) = shaShape.GroupItems(lngZaehler).Name
arrShapes(1, lngShapes) = shaShape.GroupItems(lngZaehler).DrawingObject.Font.Color
arrShapes(2, lngShapes) = shaShape.Line.ForeColor
arrShapes(3, lngShapes) = shaShape.Line.Visible
lngShapes = lngShapes + 1
Application.Goto reference:=shaShape.GroupItems(lngZaehler).TopLeftCell, Scroll:=True
With shaShape.GroupItems(lngZaehler)
.DrawingObject.Characters( _
Start:=InStr(1, .DrawingObject.Text, varFrage, 1), _
Length:=Len(varFrage)).Font.ColorIndex = 3
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
.Select
MsgBox "Gefunden in " & .Name
End With
End If
End If
Next lngZaehler
End If
Next shaShape
End If
For lngZaehler = 0 To UBound(arrShapes(), 2)
With ActiveSheet.Shapes(arrShapes(0, lngZaehler))
.DrawingObject.Font.Color = arrShapes(1, lngZaehler)
.Line.ForeColor.RGB = arrShapes(2, lngZaehler)
.Line.Visible = arrShapes(3, lngZaehler)
End With
Next lngZaehler
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Beverly, 3. Juli 2015

#25
FALKE89

Falke89

Hi Beverly und xlph,

Danke für eure super Arbeit.

Jetzt funktioniert auch alles so wie ich mir das vorgestellt habe.

Das ist einfach toll, wie einem hier geholfen wird!!!

Gruß und Danke,
Manuel

Falke89, 5. Juli 2015

#26
XLPH

xlph

Hallo,

- ist es möglich, dass die Suche "Leerzeichen" ignoriert, das heißt wenn ich "Seite 3" im Textfeld habe, dass dann der Eintrag mit Sucheintrag "Seite 3" aber auch "Seite3" gefunden wird???
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Setze "*" als Platzhalter

- ist es möglich, solange das Suchfenster offen ist, an der Arbeitsmappe zu arbeiten (Ich habe bei den Endzweigen Links hinterlegt, die könnte man dann bei geöffneter/aktiver Suche öffen)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

frmSuche.Show vbModeless ' (einkommentieren)
Es gibt einen weiteren Button ('Aktualisieren'). Dieser aktualisiert die Liste
falls Änderungen am Text der gefundenen Formen durchgeführt wurde.
Ist umgesetzt.

- ist es möglich, wenn kein Treffer gefunden wurde, eine Meldung "Kein Treffer" auszugeben?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nach 'Suchergebnis:' wird jetzt die Anzahl der Funde angezeigt. 0 = Kein Fund.

- ist es möglich, die Suche zusätzlich mit Enter zu starten???
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ist umgesetzt.

xlph, 10. Juli 2015

#27
FALKE89

Falke89

Suchfunktion für Textfelder VBA (Textfeldsuche)

Hallo xlph,

vielen Dank für deine Hilfe, funktioniert einwandfrei *top

Gruß Manuel

Falke89, 12. Juli 2015

#28
FALKE89

Falke89

Eine Sache hätte ich jetzt noch, weiß aber nicht ob das zu lösen ist!?

Ich habe beispielsweise in einem Textfeld wegen Platzmangel "Durchgangs-löcher" stehen.

Wenn jetzt jemand nach Durchgangslöchern sucht, kommt als Ergebnis "Keine Übereinstimmung!".
Da ja keiner weiß, dass in diesem Falle ein Bindestrich verwendet wurde, glaubt er, dass dieser Suchbegriff nicht vorhanden ist.

Könnte man das irgendwie lösen, dass Bindestriche keine Auswirkung auf das Suchergebnis haben?

Danke schonmal für die Mühe *Smilie

Gruß Manuel

Falke89, 12. Juli 2015

#29
XLPH

xlph

Versuche es hiermit.

Statt einer TextBox wird eine ComboBox verwendet.

xlph, 13. Juli 2015

#30

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 2 von 3

Thema:

Suchfunktion für Textfelder VBA (Textfeldsuche)

Die Seite wird geladen...

Suchfunktion für Textfelder VBA (Textfeldsuche) - Similar Threads - Suchfunktion Textfelder VBA
Suchfunktion
in Microsoft Excel Hilfe
Suchfunktion: Ist es in der Suchfunktion (Strg + F) möglich, das als Voreinstellung nicht "Blatt" eingestellt ist, sondern "Arbeitsmappe".
Suchfunktion erstellen
in Microsoft Excel Hilfe
Suchfunktion erstellen: Hallo Gemeinde, ich bin neu hier und bitte um Hilfe. Ich möchte eine Tabelle erstellen, die zur Suche von Datenanschlüssen verwendet werden soll. Fakten: 10 Gebäude mit je einem Datenschrank;...
Suchfunktion für Listbox in Textbox
in Microsoft Excel Hilfe
Suchfunktion für Listbox in Textbox: Hallo an alle hier im Forum, ich bastel mal wieder ein wenig rum. Ich habe ein 2 spaltige Listbox. In der 1. Spalte stehen Zahlen von einstellig bis sechsstellig und in der 2. Spalte Namen. Im...
Suchfunktion beschleunigen
in Microsoft Word Hilfe
Suchfunktion beschleunigen: Hallo, ich habe ein sehr großes Word-Dokument in dem ich sehr oft suche. Die Suche starte ich i.d.R. vom Anfang des Dokuments weil ich dann sehr häufig eine Fundstelle direkt im Inhaltsverzeichnis...
Suchfunktion in Zeile einbinden ?
in Microsoft Excel Hilfe
Suchfunktion in Zeile einbinden ?: Hallo zusammen, leider finde ich irgendwie keine Lösung zu meinem Problem. Glaube aber das es gar nicht so schwer sein dürfte. Ich möchte einfach nur genau das gleiche was die Suchfunktion macht...
Suchfunktion innerhalb der Foren
in Lob, Kritik und Verbesserungsvorschläge
Suchfunktion innerhalb der Foren: Hallo and das Office-Hilfe Team, ich bin vor Kurzem auf eure Seite aufmerksam geworden und finde sie sehr gut. Innerhalb der Foren ist es zwar möglich die Fragen und entsprechenden Antworten auf...
Find,Suchfunktion funktioniert nicht bei Excel 2016
in Microsoft Excel Hilfe
Find,Suchfunktion funktioniert nicht bei Excel 2016: Hallo zusammen, Ich habe ein Problem. Ich habe eine Suchfunktion: =WENN($K$1="";"";FILTER($A$2:$H$15000;ISTZAHL(SUCHEN($K$1;$A$2:$A$15000)))) Diese Funktioniert im office 365 Excel einwandfrei....

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden