Thema Datum  Von Nutzer Rating
Antwort
05.03.2019 18:09:50 Damian
NotSolved
Blau Distanzfunktion für Datenpunkte
05.03.2019 19:45:00 Ulrich
NotSolved

Ansicht des Beitrags:
Von:
Ulrich
Datum:
05.03.2019 19:45:00
Views:
402
Rating: Antwort:
  Ja
Thema:
Distanzfunktion für Datenpunkte

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.03.2019 18:09:50 Damian
NotSolved
Blau Distanzfunktion für Datenpunkte
05.03.2019 19:45:00 Ulrich
NotSolved