HERBERS Excel-Forum - das Archiv

Thema: VBA Funktion SVERWEISPLUS mit Fehler bei Excel Mac Version

VBA Funktion SVERWEISPLUS mit Fehler bei Excel Mac Version
Thomas Brill
Hallo ich suche einen Excel Mac Spezialisten

ich habe einen Excel Checkliste mit Makros erstellt und eine Externe Funktion SVERWEISPLUS eingefügt.
Auf Windows Rechnern funktioniert es einwandfrei. Nur bei Mac's kommt beim SVERWEISPLUS ein Fehler in dieser Zeile bei CDec
Set After = C.Cells(C.Rows.Count * CDec(C.Columns.Count))
.

Wir verteilen die Excel Datei an unsere Architekten. Einige Arbeiten aber nur mit MAC.
Leider haben wir keinen MAC um das testen und korrigieren zu können.

Wer kann mir weiterhelfen?



Option Explicit

'-----------------------------------------------------------------------------------------------------------------------
' Modul Function SVERWEISPLUS,
'
' Funktionsaufruf: SVERWEISPLUS(vSuchen As Variant, vArea As Range, vSpalte As Long, Optional vSeparator As Variant)
'
' FastUnion algorithm © Andreas Killer, 2011:
'
' Quelle: https://answers.microsoft.com/de-de/msoffice/forum/all/sverweis-plus-mit-aus-gabe-mehrerer-werte-in-einer/ca46a7fc-e381-4dd0-880a-484e2a774770
'-----------------------------------------------------------------------------------------------------------------------

Function SVERWEISPLUS(vSuchen As Variant, vArea As Range, vSpalte As Long, _
Optional vSeparator As Variant)
Dim All As Range, R As Range
Set All = FindAll(vArea.Columns(1), vSuchen, SearchFormat:=True)
If All Is Nothing Then
SVERWEISPLUS = CVErr(xlErrNA)
Else
For Each R In All
Set R = Intersect(vArea.Columns(vSpalte), R.EntireRow)
SVERWEISPLUS = SVERWEISPLUS & R.Value & vSeparator
Next
SVERWEISPLUS = Left(SVERWEISPLUS, Len(SVERWEISPLUS) - Len(vSeparator))
End If
End Function

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, _
Optional ByVal SearchFormat As Boolean = False) As Range
'Alle Vorkommen von „Was“ in „Wo“ finden (Windows-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
'Setzen Sie „Nachher“ auf die letzte Zelle in „Wo“, um die erste Zelle in „Woher“ davor zurückzugeben, wenn sie mit „Was“ übereinstimmt.
Set C = Where.Areas(Where.Areas.Count)
'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet
'Set After = C.Cells(C.Cells.Count)
Set After = C.Cells(C.Rows.Count * CDec(C.Columns.Count))
End If

Set C = Where.Find(What, After, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
If C Is Nothing Then Exit Function

FirstAddress = C.Address
Do
Stack.Add C
If SearchFormat Then
'Wenn Sie diese Funktion von einer UDF aus aufrufen und nur die erste Zelle finden, verwenden Sie stattdessen Folgendes
Set C = Where.Find(What, C, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
Else
If SearchDirection = xlNext Then
Set C = Where.FindNext(C)
Else
Set C = Where.FindPrevious(C)
End If
End If
'Kann passieren, wenn wir Zellen zusammengeführt haben
If C Is Nothing Then Exit Do
Loop Until FirstAddress = C.Address

'FastUnion algorithm © Andreas Killer, 2011:
'Alle Zellen als Fragmente abrufen
ReDim Temp(0 To Stack.Count - 1)
i = 0
For Each Item In Stack
Set Temp(i) = Item
i = i + 1
Next
'Kombiniere jedes Fragment mit dem nächsten
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)
'An diesem Punkt haben wir alle Zellinhalte die der Suche entsprechen zusammengefast
Set FindAll = Temp(0)
End Function




AW: VBA Funktion SVERWEISPLUS mit Fehler bei Excel Mac Version
daniel
Hi
es wäre natürlich interessant zu wissen, welcher Fehler denn kommt (Nummer, Text).
oder hast du "Gründe", uns diesen zu verschweigen?

vermutlich kennt der Mac den Datentyp DEC nicht.
probiere es mal mit CDBL oder referenziere die letzte Zelle so, wie es üblich ist über Zeilen und Spalten.
Set After = C.Cells(C.Rows.Count, C.Columns.Count)


Gruß Daniel
AW: VBA Funktion SVERWEISPLUS mit Fehler bei Excel Mac Version
daniel
Hi
noch ne Variante

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


Gruß Daniel
AW: VBA Funktion SVERWEISPLUS mit Fehler bei Excel Mac Version
Thomas Brill
Hallo Daniel

hier die Fehlermeldung.
Fehler beim Kompilieren:
"Sub" oder "Funktion" ist nicht definiert.

Ich habe das "Set After" mal geändert
Set After = C.Cells(C.Rows.Count, C.Columns.Count)

und die Datei zum testen weitergleitet.
Kann leider etwas dauern, bis ich eine Antwort bekomme.

Vielen Dank schon mal.

Gruß Thomas
AW: VBA Funktion SVERWEISPLUS mit Fehler bei Excel Mac Version
Thomas Brill
Hallo Daniel

meine externe Testuserin mit Mac hat mir mitgeteilt das jetzt alles perfekt funktioniert.

Vielen Dank.

Das Problem ist gelöst.

Option Explicit


'-----------------------------------------------------------------------------------------------------------------------
' Modul Function SVERWEISPLUS, 02-2025
'
' Funktionsaufruf: SVERWEISPLUS(vSuchen As Variant, vArea As Range, vSpalte As Long, Optional vSeparator As Variant)
'
' FastUnion algorithm © Andreas Killer, 2011:
'
' Quelle: https://answers.microsoft.com/de-de/msoffice/forum/all/sverweis-plus-mit-aus-gabe-mehrerer-werte-in-einer/ca46a7fc-e381-4dd0-880a-484e2a774770
'-----------------------------------------------------------------------------------------------------------------------

Function SVERWEISPLUS(vSuchen As Variant, vArea As Range, vSpalte As Long, _
Optional vSeparator As Variant)
Dim All As Range, R As Range
Set All = FindAll(vArea.Columns(1), vSuchen, SearchFormat:=True)
If All Is Nothing Then
SVERWEISPLUS = CVErr(xlErrNA)
Else
For Each R In All
Set R = Intersect(vArea.Columns(vSpalte), R.EntireRow)
SVERWEISPLUS = SVERWEISPLUS & R.Value & vSeparator
Next
SVERWEISPLUS = Left(SVERWEISPLUS, Len(SVERWEISPLUS) - Len(vSeparator))
End If
End Function

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, _
Optional ByVal SearchFormat As Boolean = False) As Range
'Alle Vorkommen von „Was“ in „Wo“ finden (Windows-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
'Setzen Sie „Nachher“ auf die letzte Zelle in „Wo“, um die erste Zelle in „Woher“ davor zurückzugeben, wenn sie mit „Was“ übereinstimmt.
Set C = Where.Areas(Where.Areas.Count)
'Set After = C.Cells(C.Rows.Count * CDec(C.Columns.Count)), funktioniert nicht auf einem Mac
' Das Set unten funktioniert unter Mac und Windows.
Set After = C.Cells(C.Rows.Count, C.Columns.Count)
End If

Set C = Where.Find(What, After, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
If C Is Nothing Then Exit Function

FirstAddress = C.Address
Do
Stack.Add C
If SearchFormat Then
'Wenn Sie diese Funktion von einer UDF aus aufrufen und nur die erste Zelle finden, verwenden Sie stattdessen Folgendes
Set C = Where.Find(What, C, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
Else
If SearchDirection = xlNext Then
Set C = Where.FindNext(C)
Else
Set C = Where.FindPrevious(C)
End If
End If
'Kann passieren, wenn wir Zellen zusammengeführt haben
If C Is Nothing Then Exit Do
Loop Until FirstAddress = C.Address

'FastUnion algorithm © Andreas Killer, 2011:
'Alle Zellen als Fragmente abrufen
ReDim Temp(0 To Stack.Count - 1)
i = 0
For Each Item In Stack
Set Temp(i) = Item
i = i + 1
Next
'Kombiniere jedes Fragment mit dem nächsten
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)
'An diesem Punkt haben wir alle Zellinhalte die der Suche entsprechen zusammengefast
Set FindAll = Temp(0)
End Function


Gruß Thomas