XY Koordinaten - Abstände berechnen

[grijo]

Ich habe eine Tabelle mit XY Koordinaten und benötige nun den Abstand aller Koordinaten zueinander, also von

Pos1 zu Pos2, Pos3, ...PosXY
Pos2 zu Pos3, Pos3, ...PosXX
usw.


Die Anzahl der Koordinaten ist nicht fix, da die Daten aus einem CAD Programm nach Excel exportiert werden.

Der Formel für den eigentlichen Abstand zwischen 2 Punkten ist nicht das Problem, ich weiß aber nicht wie ich automatisch die Tabelle durcharbeiten lassen kann
damit jeder Punkt zu jedem Punkt gemessen und dargestellt wird.
Über Formel Funktionen habe ich bisher keine Lösung gefunden, ich vermute man muss hier ein Script machen.
Allerdings bin ich mit VBscript ein Anfänger.

Die Tabelle sieht auszugsweise so aus.
[img]
Dateiupload bitte im Forum! So geht es: Klick mich!
]

Gruss Joachim

[LCohen]

Klassische Entfernungsmatrix (hier nur 3x3), Pythagoras, fertig:

A3:B5: {={15,2.8;15.9;13.10}}

C1:E2: =INDEX($A:$B;SPALTE();ZEILE())

C3:E5: =((C$1-$A3)^2+(C$2-$B3)^2)^0,5

[Ego]

Hallo Joachim,

hier einmal ein Programm.
Da ich ungern mit festen Adressen im Programm arbeite, benötigt es zur Zeit zwei benannte Zellen. Diese können beliebig in der Datei verschoben werden (auch in andere Blätter) ohne das Programm anpassen zu müssen.

A. benannte Zelle "Eingabe"
Die linke obere Zelle der Liste. die Grenze der Liste erkennt das Programm über "CurrentRegion" an der nächsten Leerzeile und-spalte.
1. In der ersten Zeile der Liste sind Überschriften
2. In der ersten Spalte der Liste sind die Punktbezeichnungen
3. in den Spalten 2 und 3 sind die Koordinaten der Punkte.

B. benannte Zelle "Ausgabe"
Ab dieser Zelle wird die Entfernungsmatrix geschrieben. Eventuell schon vorhandene Inhalte werden gnadenlos überschrieben. Falls sich die Anzahl der Punkte reduziert, solltest du die alten Daten vorher löschen.

Code:

Private Sub cbTuwat_Click()
Dim lngZeile As Long
Dim lngZeilen As Long
Dim lngSpalte As Long
Dim varEingabe() As Variant
Dim varAusgabe() As Variant

varEingabe = ThisWorkbook.Names("Eingabe").RefersToRange.CurrentRegion.Value
lngZeilen = UBound(varEingabe, 1)
ReDim varAusgabe(1 To lngZeilen, 1 To lngZeilen)
varAusgabe(1, 1) = "Abstand"
For lngZeile = 2 To lngZeilen
    varAusgabe(1, lngZeile) = varEingabe(lngZeile, 1)
    varAusgabe(lngZeile, 1) = varEingabe(lngZeile, 1)
Next lngZeile
For lngZeile = 2 To lngZeilen
    For lngSpalte = lngZeile + 1 To lngZeilen
        varAusgabe(lngZeile, lngSpalte) = Sqr((varEingabe(lngZeile, 2) - varEingabe(lngSpalte, 2)) ^ 2 + _
                                               (varEingabe(lngZeile, 3) - varEingabe(lngSpalte, 3)) ^ 2)
        varAusgabe(lngSpalte, lngZeile) = Sqr((varEingabe(lngZeile, 2) - varEingabe(lngSpalte, 2)) ^ 2 + _
                                               (varEingabe(lngZeile, 3) - varEingabe(lngSpalte, 3)) ^ 2)
    Next lngSpalte
Next lngZeile

ThisWorkbook.Names("Ausgabe").RefersToRange.Resize(lngZeilen, lngZeilen).Value = varAusgabe
End Sub

[grijo]

Vielen Dank für das Script.

Jetzt habe ich alle Abstandswerte, nun muss ich das Ganze noch erweitern damit mir alle Abstände < einem frei vorgebenem Sollwert z.B. ROT angezeigt werden.

Joachim

[Ego]

Hallo Joachim,

hier ein Beispiel (mit einer zusätzlichen benannten Zelle "Sollwert") in dem eine bedingte Formatierung für den Ausgabebereich definiert wird.

Code:

With ThisWorkbook.Names("Ausgabe").RefersToRange
    .CurrentRegion.FormatConditions.Delete
    .CurrentRegion.Value = ""

    strAdresse = Replace(.Address, "$", "")
    With .Resize(lngZeilen, lngZeilen)
        .Value = varAusgabe
        .FormatConditions.Add Type:=xlExpression, Formula1:="=" & strAdresse & "<Sollwert"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1)
            .Font.Bold = True
            .Font.Color = vbRed
            .StopIfTrue = False
        End With
    End With
End With

[grijo]

Ich bin echt beeindruckt wie schnell einem hier geholfen wird.
Angemeldet, ersten Beitrag verfasst und kurze Zeit später die erste Lösungsvorschläge.

Vielen Dank.

Ich habe allerdings bei der Problembeschreibung einen Punkt übersehen.
Die einzelnen Punkte können entweder auf der Ober- oder Unterseite liegen.
Es sollen jeweils nur die Punkte der Ober- oder Unterseite miteinander verglichen werden, es werden also 2 Abstandstabellen notwendig sein. ( Abstand Top; Abstand Bottom )

Sorry das ich hiermit hinterher komme ......

Joachim

[img]
Dateiupload bitte im Forum! So geht es: Klick mich!
]

[LCohen]

Autofiltere nacheinander nach Top und Bottom und kopiere die Filter-Ergebnisse in jeweils eine neue Tabelle. Dann kannst Du auf letztere beide jeweils die Lösungen anwenden.

[Ego]

Hallo Joachim,

in der Anlage eine vielleicht interessante Lösung mit einer Abstandstabelle. Hierbei muste ich nur eine If-Verzweigung einbauen.

Eine Lösung mit zwei Abstandstabellen folgt.

Wird es denn immer bei den zwei Seiten bleiben?

[Ego]

Hallo Joachim,

hier mit zwei Abstandstabellen:

[grijo]

Danke, das funktioniert schon recht gut.
Ich habe aber noch die eine oder andere Hürde zu überwinden bis alles so aussieht wie gewünscht.

Die Tabellenwerte werden von einem CAD System in eine Textdatei geschrieben. ( Beispiel hängt an )
Diese Tabellenwerte sollen dann in das Excelsheet eingelesen werden.
Habe dazu ein Makro aufgezeichnet und es funktioniert auch prinzipiell.
Ich muss nun aber als erstes das Makro laufen lassen, und danach das "Tuwat" Script.
Beide Aktionen kann man doch sicherlich zusammenfassen damit das Einlesen und die Kalkulation der Abstände gemeinsam erledigt werden.

Ich bin auch noch auf der Suche wo ich die Anzahl der Nachkommastellen begrenzen kann.
Es reichen 2 Nachkommastellen aus, das macht die Tabelle ein wenig "schlanker".



Sorry für die Anfängerfragen, aber bisher haben mir die einfachen Formeln in Excel gereicht und ich musste nicht mit Scripten oder Makros hantiieren.

Joachim