Suchfunktion über Tabellenblätter

Mach mal eine neue Datei, kopier den Code in ein reguläres Modul, Sub Example_FindAll laufen lassen, in das Direktfenster kucken.

Alles klar?

Andreas.

Private Sub Example_FindAll()

Dim Y As Long, R As Range, All As Range

For Y = 1 To 7 Step 2

Cells(Y, 1) = 1

Cells(Y + 1, 1) = 2

Next

Set All = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))

Debug.Print All.Address

Set R = FindAll(All, 1, SearchDirection:=xlNext)

Debug.Print R.Address

Set R = FindAll(All, 1, SearchDirection:=xlPrevious)

Debug.Print R.Address

'https://support.microsoft.com/en-us/kb/214138

'To find "*" "?" or "~" use "~*" "~?" or "~~"

End Sub

Function FindAll(ByVal Where As Range, ByVal What, _

Optional ByVal After As Variant, _

Optional ByVal LookIn As XlFindLookIn = xlValues, _

Optional ByVal LookAt As XlLookAt = xlWhole, _

Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _

Optional ByVal SearchDirection As XlSearchDirection = xlNext, _

Optional ByVal MatchCase As Boolean = False) As Range

'Find all occurrences of What in Where (Mac version)

Dim FirstAddress As String

Dim c As Range

'From FastUnion:

Dim Stack As New Collection

Dim Temp() As Range, Item

Dim i As Long, j As Long

If Where Is Nothing Then Exit Function

If SearchDirection = xlNext And IsMissing(After) Then

'Set After to the last cell in Where to return the first cell in Where in front if _

it match What

Set c = Where.Areas(Where.Areas.Count)

If Val(Application.Version) > 11 Then

Set After = c.Cells(c.Cells.CountLarge)

Else

Set After = c.Cells(c.Cells.Count)

End If

End If

Set c = Where.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase)

If c Is Nothing Then Exit Function

FirstAddress = c.Address

Do

Stack.Add c

'If you call this function from an UDF and _

you find only the first cell use this instead

'Set C = Where.Find(What, C, LookIn, LookAt, SearchOrder, _

SearchDirection, MatchCase)

If SearchDirection = xlNext Then

Set c = Where.FindNext(c)

Else

Set c = Where.FindPrevious(c)

End If

'Can happen if we have merged cells

If c Is Nothing Then Exit Do

Loop Until FirstAddress = c.Address

'FastUnion algorithm © , 2011:

'Get all cells as fragments

ReDim Temp(0 To Stack.Count - 1)

i = 0

For Each Item In Stack

Set Temp(i) = Item

i = i + 1

Next

'Combine each fragment with the next one

j = 1

Do

For i = 0 To UBound(Temp) - j Step j * 2

Set Temp(i) = Union(Temp(i), Temp(i + j))

Next

j = j * 2

Loop Until j > UBound(Temp)

'At this point we have all cells in the first fragment

Set FindAll = Temp(0)

End Function

Gibt es eine Möglichkeit das in Excel zu machen?

Ja, schon, aber das musst Du alles programmieren. Ich hab jetzt keinen Mac mit XL365, aber unter Windows gibt es das hier, reicht das nicht?

Andreas.

Verstehe verstehe...

Ja programmieren kann ich. wär super wenn du mir das schicken könntest! Danke

Hallo Andreas,

Es würde prinzipiell reichen, jedoch ist es nicht sehr übersichtlich. Wenn ich die Zeilen vollständig angezeigt bekommen würde und nicht nur in der jeweiligen Mappe markiert, würde mir das sehr viel Arbeit ersparen, da in den einzelnen Listen sehr viele Daten
vorkommen und ich diese vergleichen muss...

Hat das meinst du noch niemand programmiert?

LG

Wenn ich die Zeilen vollständig angezeigt bekommen würde

Hat das meinst du noch niemand programmiert?

a) Sobald Du eine andere Zeile im Suchfenster anklickst springt er da hin...

b) Doch, schon viele, gibt es überall im Netz, ist eine FAQ. Nur jeder will das anders haben, daher gibt es hunderte verschiedene Lösungen.

Wenn Du programmieren kannst... eine FindAll für ein Tabellenblatt kann ich Dir geben.

Andreas.