Collapse column

Autor Thema: Office 2013: Excel Inventar nach mehreren Kriterien durchsuchen und Sortieren. HILFE benötigt  (Gelesen 1719 mal)

Offline Lagerregal

  • Newbie
  • *
  • Beiträge: 1
    • Profil anzeigen
  • Office-KnowHow: Fortgeschritten
  • VBA-KnowHow- : Wenig
  • Version [Office] : Office 2013
Hallöchen. ICh habe eine Excel Inventar Liste angefertigt.
Diese ist wie in der Anlage "sortiert" nach Name Soll und Ist und Standort gegliedert.
Einen Ausschnitt derTabelle lege ich in der Anlage "Tabellenausschnitt Beispiel" bei.
Zusätzlich zu der Tabelle habe ich mit 2 Datenschnitten 2 Auswhlmenüs erstellt, mit denen man nach Raum oder Größe Sortieren kann. Dies funktioniert auch.

Nun meine Frage. Ich wollte mit einem Makro was aufgerufen wird, wenn man auf Suchen klickt nach dem jeweiligen Begriff suchen. Dies funktionert auch, wenn man den Begriff inkl roß und KLeinschreibung richtig eingibt.

Nun soll er aber wenn man zB nur "Natriumhy" eingiebt nicht nur nach dem Wort an sich suchen sondern auch alle anderen Wörter/Zellen anzeigen, wo dieser Suchbegriff enthalten ist.

Weiteres Beispiel: In einigen Zellen stehen der Stoffname und DInge wie 97ig oder reinstoff oder so etwas direkt nach dem Namen. Gebe ich nun reinstoff ein soll er alle Anzeigen wo das irgendiwe enthalten ist.

Welche Makrolösung gibt es da?

Was ich bisher habe was halt nur nach dem Sucht was haargenau eingegeben worden ist sieht so aus:
Dieses ist kopüiert und darf weiterverwendet werden. Allerdings funktioniert dies auch nie bis zum Ende... Gesucht wird halt trotzdem allerdings nur so wie oben beschrieben..
---------------------------------------------------
Sub Suchen()

Dim str_SuchString As String
Dim Counter1 As Integer
Dim Counter2 As Integer
str_SuchString = InputBox("Geben Sie ein Wort nachdem Sie suchen möchten ein:", "Suche...")
For Counter1 = 1 To ActiveSheet.Cells.SpecialCells(xlLastCell).Column
For Counter2 = 1 To ActiveSheet.Cells.SpecialCells(xlLastCell).Row
If Cells(Counter2, Counter1).Value = str_SuchString Then
Cells(Counter2, Counter1).Select
End If
Next
Next
End Sub
Sub Wortmarkierung()
' ein original Klexy-Makro
' Sucht das eingegebene Wort entweder im gesamten verwendeten Bereich des Tabellenblatts
' oder nur im markierten Bereich, wenn ein Bereich von 2 oder mehr Zellen markiert ist

' Variablen festlegen:
Dim zAnzahl As Long, zRange As Range, zFarbe As Integer, zWort As String, i As Integer

' Variablen definieren:
zAnzahl = Selection.Cells
Set zRange = Selection ' Bereich der markierten Zellen
zFarbe = 6 ' Farbe, mit der die Zeile eingefärbt werden soll
' Info zu den Farben hier: Farben
i = 0 ' der Zähler zählt die Anzahl der male, bei denen kein Suchwort in die Eingabemaske eingetragen wird


ActiveSheet.Cells.Interior.ColorIndex = 0
' zuerst wird das ganze Tabellenblatt entfärbt, damit es
' keine von der vorigen Wortsuche übriggebliebene Färbungen gibt

NochmalEingeben:
'Eingabemaske für das Suchwort:
zWort = InputBox(Chr(13) & Chr(13) & "Bitte Suchwort eintragen" & Chr(13) & "", "Zeile mit Suchwort markieren")
' Groß/Kleinschreibung wird nicht berücksichtigt, es können auch Ziffern sein

If zWort = "" Then ' wenn kein Suchwort in die Eingabemaske eingegeben wurde
i = i + 1 ' wenn kein Suchwort eingegeben wurde, wird der Zähler um 1 hochgezählt

If i <= 2 Then ' wenn der Zähler 2 ist, wird das Makro abgebrochen
Exit Sub
Else
MsgBox "Es muss mindestens ein Zeichen eingegeben werden."
'i = i + 1
GoTo NochmalEingeben ' wenn der Zähler unter 2 ist, springt das Makro nochmal zur Eingabemaske
End If

Else

If zAnzahl > 1 Then ' wenn mehrere Zellen markiert sind
For Each Cell In zRange
If InStr(1, Cell.Value, zWort) > 0 Then
Cell.EntireRow.Interior.ColorIndex = zFarbe
Else
End If
On Error Resume Next
Next Cell
Else ' wenn nix markiert ist, also das ganze Blatt durchsucht werden soll
For Each Cell In ActiveSheet.UsedRange
If InStr(1, Cell.Value, zWort) > 0 Then
Cell.EntireRow.Interior.ColorIndex = zFarbe
Else
End If
On Error Resume Next
Next Cell
End If

End If
MsgBox " Feddisch. "

End Sub
------------------------------------------------------





Ich freue mich über hoffentlich sehr hilfreiche Antworten.

Im optimalsten Falle währe es zusätzlich natürlich auch schön dieses Ergebnis in eine 2. Excelseite direkt zum Uasdruck parat zu bekommen ... je nachdem wie kompliziert das ist ist es auch ein Wunsch.

Keine Lösung gefunden? Du kannst Dich gerne an unser erfahrenes Experten-Team wenden und Dein Anliegen in Auftrag geben.
>>> Schnell und einfach ein unverbindliches Angebot anfordern. Per E-Mail an anfrage@excel-inside.de oder per Online-Formular
<<<

!!! Wichtige Information
!!! Dieses Forum steht aus technischen Gründen ab dem 11. September 2019 nur noch im Lesemodus zur Verfügung.
Das NEUE Office-Fragen-Forum kannst du aber unter der gewohnten Domain https://office-fragen.de wie gewohnt nutzen.

- Wir freuen uns auf deinen Besuch im neuen Forum.