Funktion für das min/max eines arrays
26.08.2016 15:11:59
Gerhard
Ich versuche seit geraumer Zeit mir eine Funktion zu schreiben, welche mir die Min bzw Maximalwerte eines mehrdimensionalen Arrays in einem neuen Array ausgibt.
Das Array beinhaltet auch leere Datenfelder, was zu dem Problem führt, dass der Rückgabewert Null ist. Da es sich bei dem Daten um Koordinatenpunkte handelt brauche ich allerdings die null auch, weshalb ich das Array mit Daten des types string fülle.
Nachfolgend findet Ihr die Funktionen mit einem Beispiels des Arrays
Sub test1()
Dim myarray(10, 1)
Dim myarray_min()
myarray(0, 0) = -25
myarray(1, 0) = 55
myarray(2, 0) = 0
myarray(2, 0) = 45
myarray(3, 0) = -15
myarray(4, 0) = ""
myarray(5, 0) = ""
myarray(6, 0) = ""
myarray(7, 0) = ""
myarray(8, 0) = ""
myarray(9, 0) = ""
myarray(10, 0) = ""
myarray(0, 1) = ""
myarray(1, 1) = ""
myarray(2, 1) = ""
myarray(3, 1) = ""
myarray(4, 1) = ""
myarray(5, 1) = -15
myarray(6, 1) = -35
myarray(7, 1) = -47
myarray(8, 1) = -15
myarray(9, 1) = 0
myarray(10, 1) = ""
myarray_min = MIN_von_arr_test(myarray)
myarray_max = MAX_von_arr_test(myarray)
For i = 0 To 1
Debug.Print (myarray_min(i))
Debug.Print (myarray_max(i))
Next i
End Sub
Function MAX_von_arr_test(ByVal arr As Variant)
Dim Dim_arr As Long
Dim_arr = arr_Dim_count_Test(arr)
ReDim arr_max(Dim_arr - 1)
If Not IsArray(arr) Then Exit Function
On Error Resume Next
For i = 0 To Dim_arr
For j = LBound(arr) To UBound(arr)
For k = LBound(arr) To UBound(arr)
If IsNumeric(arr(j, i)) And IsNumeric(arr(k, i)) And _
CDbl(arr(j, i)) > CDbl(arr(k, i)) And CDbl(arr(j, i)) > arr_max(i) Then
arr_max(i) = CDbl(arr(j, i))
End If
Next k
Next j
Next i
MAX_von_arr_test = arr_max
End Function
Function MIN_von_arr_test(ByVal arr As Variant)
Dim Dim_arr As Long
Dim_arr = arr_Dim_count_Test(arr)
ReDim arr_min(Dim_arr - 1)
If Not IsArray(arr) Then Exit Function
On Error Resume Next
For i = 0 To Dim_arr
For j = LBound(arr) To UBound(arr)
For k = LBound(arr) To UBound(arr)
If IsNumeric(arr(j, i)) And IsNumeric(arr(k, i)) And _
CDbl(arr(j, i)) Function arr_Dim_count_Test(arr As Variant)
Dim i As Long
Dim LB As Long
If Not IsArray(arr) Then Exit Function
On Error Resume Next
' Es wird bis 61 gegangen, um in jedem Fall einen
' Fehler zu provozieren, so dass keine weitere
' Fallunterscheidung notwendig ist, falls das Array
' 60 Dimensionen haben sollte:
For arr_Dim_count_Test = 1 To 61
LB = LBound(arr, arr_Dim_count_Test)
If Err.Number 0 Then Exit For
Next
arr_Dim_count_Test = arr_Dim_count_Test - 1
End Function