M
MSCom
Neuer Benutzer
Threadstarter
- Dabei seit
- 20.09.2016
- Beiträge
- 1
Hallo zusammen,
wenn ich diese Function+Sub in Excel anwende kommt folgende Fehlermeldung:
Fehler beim kompilieren - Sub oder Function nicht definiert. FindAll ist blau markiert, und
Function sverweisplus(vSuchen As Variant, vArea As Range, vSpalte As Long, _
Optional vSeparator As Variant)
ist gelb markiert.
Warum
?
Danke im voraus!
Function sverweisplus(vSuchen As Variant, vArea As Range, vSpalte As Long, _
Optional vSeparator As Variant)
Dim All As Range, R As Range
Dim Data
Dim i As Long, k As Long
Set All = FindAll(vArea.Columns(1), vSuchen, SearchFormat:=True)
If All Is Nothing Then
sverweisplus = CVErr(xlErrNA)
Else
'Leeres Array erzeugen => Data(0 to -1)
Data = Array()
For Each R In All
Set R = Intersect(vArea.Columns(vSpalte), R.EntireRow)
'Um eins größer machen
ReDim Preserve Data(0 To UBound(Data) + 1)
'Am Ende den Wert speichern
Data(UBound(Data)) = R.Value
Next
'Sortieren
InsertionSort_Prim Data
'Doppelte Werte entfernen
For i = 1 To UBound(Data)
If Data(i) <> Data(i - 1) Then
k = k + 1
If i > k Then Data(k) = Data(i)
End If
Next
ReDim Preserve Data(0 To k)
'Als String zurückgeben
sverweisplus = Join(Data, vSeparator)
End If
End Function
Sub InsertionSort_Prim(ByRef Liste)
Dim i As Long, j As Long, Temp
For i = LBound(Liste) + 1 To UBound(Liste)
Temp = Liste(i)
For j = i - 1 To LBound(Liste) Step -1
If Liste(j) <= Temp Then Exit For
Liste(j + 1) = Liste(j)
Next
Liste(j + 1) = Temp
Next
End Sub
wenn ich diese Function+Sub in Excel anwende kommt folgende Fehlermeldung:
Fehler beim kompilieren - Sub oder Function nicht definiert. FindAll ist blau markiert, und
Function sverweisplus(vSuchen As Variant, vArea As Range, vSpalte As Long, _
Optional vSeparator As Variant)
ist gelb markiert.
Warum

Danke im voraus!
Function sverweisplus(vSuchen As Variant, vArea As Range, vSpalte As Long, _
Optional vSeparator As Variant)
Dim All As Range, R As Range
Dim Data
Dim i As Long, k As Long
Set All = FindAll(vArea.Columns(1), vSuchen, SearchFormat:=True)
If All Is Nothing Then
sverweisplus = CVErr(xlErrNA)
Else
'Leeres Array erzeugen => Data(0 to -1)
Data = Array()
For Each R In All
Set R = Intersect(vArea.Columns(vSpalte), R.EntireRow)
'Um eins größer machen
ReDim Preserve Data(0 To UBound(Data) + 1)
'Am Ende den Wert speichern
Data(UBound(Data)) = R.Value
Next
'Sortieren
InsertionSort_Prim Data
'Doppelte Werte entfernen
For i = 1 To UBound(Data)
If Data(i) <> Data(i - 1) Then
k = k + 1
If i > k Then Data(k) = Data(i)
End If
Next
ReDim Preserve Data(0 To k)
'Als String zurückgeben
sverweisplus = Join(Data, vSeparator)
End If
End Function
Sub InsertionSort_Prim(ByRef Liste)
Dim i As Long, j As Long, Temp
For i = LBound(Liste) + 1 To UBound(Liste)
Temp = Liste(i)
For j = i - 1 To LBound(Liste) Step -1
If Liste(j) <= Temp Then Exit For
Liste(j + 1) = Liste(j)
Next
Liste(j + 1) = Temp
Next
End Sub