Hallo,
ich habe ja schon viel gesehen, aber noch nie die Indizes L und T für Zeile und spalte (oder ein 2D-Array). Kann man machen, ich hoffe, es ließt sich für dich gut. Ich muss nämlich mein Hirn ganz schön anstrengen .... aber das macht ja nichts.
Das Bild passt nicht zu deinem Code?! - egal:
Das Exit For ist dein Problem: du verlässt die "for T = .. " - Schleife sobald eine Distanz gefunden wurde, die kleiner ist als "die erste in der Spalte". Das darfst du weder für das finden des Minimums (bei unsortierten Punkten), noch für die Berechnung der Distanzen.
Dein Code zur Ermittlung mag ansonsten richtig sein, er lässt sich IMHO nicht gut nachvollziehen, da du die äußere Schleife über die Zeilen machst und die innere über die Spalten, aber gleichzeitig in der inneren das Minimum einer Spalte suchst. Diese Minima wiederum aber in verschiedne Zeilen schreibst. Das funktioniert nur, weil deine Matrix arrTmp() symmetrisch ist, also arrTmp(L, T) = arrTmp(T, L).
Nur als persönlicher Tipp (kann auch Geschmackssache sein). Wenn du die äußere Schleife über die Zeilen machst, dann befindest du dich innerhalb der Schleife in einer Zeile. Dann kannst du das Minimum ja auch in dieser Zeile suchen. Das liest sich dann meiner Meinrung nach sehr viel einfacher (insbesondere, wenn man den Code länger nicht mehr gesehen hat, oder nicht der Autor ist) weil der Code stringenter einem Gedankengang folgt, und wenn du mal nicht symmetrische Matrizen haben solltest, kommst du auch nicht durcheinander. Das könnte dann so aussehen:
Private Sub CommandButton1_Click()
Dim L As Long
Dim T As Long
Dim d As Double 'distance
Dim Laenge As Long
Const MAXDOUBLE As Double = 1.7976931348623E+308
Laenge = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:B" & Laenge)
ReDim arrTmp(1 To UBound(arr), 1 To UBound(arr)) 'Abstandsarray
ReDim Min(1 To UBound(arr), 1 To 2) 'Minimaler Abstand jedes Punktes
Range("K1:P1000").ClearContents 'Output
For L = 1 To UBound(arr) 'Distanz berechnen und in arrTmp speichern
Min(L, 1) = MAXDOUBLE 'Initialisierung
For T = 1 To UBound(arr) 'Schleife über alle Spalten der Zeile L
d = get_Distance(arr(L, 1), arr(T, 1), arr(L, 2), arr(T, 2))
arrTmp(L, T) = d
ActiveSheet.Cells(L + 1, T + 10) = arrTmp(L, T) 'Output
'Finde Min in Zeile L
If L <> T Then
If arrTmp(L, T) < Min(L, 1) Then 'Finden des minimalen Abstands jeder Spalte
Min(L, 1) = arrTmp(L, T)
Min(L, 2) = T
End If
End If
Next T
ActiveSheet.Cells(L + 1, 19) = Min(L, 1)
Next L
End Sub
Mein erster Impuls war übrigens: "[i]Min ist ein von VBA benutzter Begriff, den darfst du nicht verwenden[/i]", doch ich glaube, das stimmt nicht (ich tummle mich zu viel in anderen Programmiersprachen ...).
Ich würde immer alle Variablen deklarieren - aber auch Geschmackssache, ich arbeite einfach immer mit Option Explicit, was mir schon viele Tippfehler aufgezeigt hat. Desshalb bin ich überzeugt, dass ich damit sehr viel Zeit spare.
Falls es dich interessiert: https://www.online-excel.de/excel/singsel_vba.php?f=4
Grüße, Ulrich
|