|
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:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | Private Sub CommandButton1_Click()
Dim L As Long
Dim T As Long
Dim d As Double
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))
ReDim Min(1 To UBound(arr), 1 To 2)
Range("K1:P1000").ClearContents
For L = 1 To UBound(arr)
Min(L, 1) = MAXDOUBLE
For T = 1 To UBound(arr)
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)
If L <> T Then
If arrTmp(L, T) < Min(L, 1) Then
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
|