Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Multisuche mit Fundbegriff Gesamtanzahl?

Forumthread: VBA: Multisuche mit Fundbegriff Gesamtanzahl?

VBA: Multisuche mit Fundbegriff Gesamtanzahl?
26.04.2007 15:03:00
dieter(drummer)
Exel und VBA SoLaLa
Hi VBA Spezialisten,
habe beiliegendes, sehr gut funktionierendes Makro aus Forum. Hier kann in einer Tabelle oder Mappe nach einem Begriff gesucht werden, der dann je Tabelle gsucht und mit der gefundenden Anzahl je Tabelle angezeigt wird. Eine Prima Hilfe.
Suche folgende Verbesserung: Der Suchbegriff soll als Gesamtanzahl aus der gesamten Mappe oder auch Tabelle, also die Summe des gefundenen Begriffs, in der MsgBox als Zahl gezeigt werden. Es kann - wie es jetzt schon geht - die Summe je Tabelle erscheinen, aber am Ende soll die Gesamtsumme des Suchbegriffs aller durchsuchten Tabellen der Mappe gezeigt werden.
Danke für's drum kümmern und freue mich auf Lösung.
Makro:

Sub MultiSuchen() ' Suchbegriff in gesamter Mappe mit Zählen
Dim x As Long
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
Set rng = wks.Cells.Find( _
what:=sFind, _
lookat:=xlWhole, _
LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
x = 0
Do
Application.Goto rng, True
x = x + 1
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then
MsgBox x & " Fundstellen", vbInformation + vbOKOnly, "Fertig"
Exit Do
End If
Loop
End If
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub


Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Probier mal ...
26.04.2007 16:02:00
Matthias
Hi,
Ich habe nur die Variable Y hinzugefügt ...


Sub MultiSuchen() ' Suchbegriff in gesamter Mappe mit Zählen
Dim x As Long, Y As Long
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
Set rng = wks.Cells.Find( _
what:=sFind, _
lookat:=xlWhole, _
LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
x = 0
Do
Application.Goto rng, True
x = x + 1
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then
MsgBox x & " Fundstellen", vbInformation + vbOKOnly, "Fertig": Y = Y + x
Exit Do
End If
Loop
End If
Next wks
MsgBox "Gesamt Fundstellen = " & Y
End Sub


Gruß Matthias

Anzeige
AW: Danke Matthias. Funktioniert toll!
26.04.2007 17:51:07
dieter(drummer)
Hi Matthias,
Danke für schnelle Hilfe. Funktioniert einwandfrei.
Mit Gruß und eine schönen, noch sonnigen Abend
Dieter(drummer)
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige