geometrisches Mapping

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
die Brute-Force-Method wäre natürlich
- für jeden Punkt aus 2 den Abstand zu jedem Rasterpunkt aus 1 berechen,das geht über den Satz des Pythagoras Abstand² = (x1-x2)² + (y1-y2)²
- dann den Rasterpunkt auswählen, der den geringsten Abstand hat.
das ist natürlich ne grössere Rechenaufgabe, die nur mit VBA sinnvoll lösbar ist, ggf noch mit aufwendigen Matrix-Formeln.
aber vielleicht lässt sich das Ergebnis auch einfacher erzielen:
- alle Koordinaten aus 1 und 2 mit einem Umrechenfaktor so multiplizieren, daß die Koordinaten der Schnittpunkte aus 1 immer ganze Zahlen mit dem Abstand 1 sind
- die Koordinaten aus 2 auf den nächsten Ganzzahligen Wert runden.
- alle Koordinaten aus 1 und 2 wieder durch den Faktor teilen, um die Original-Koordinaten zu erhalten.
das sollte sich wesentlich schneller rechnen lassen und müsste auch ohne VBA nur mit einfachen Excelformeln umsetztbar sein.
über die gleichen Koordinaten müsste dann auch der entsprechende ABC-Wert aus 1 auffindbar sein, aber das ist dann ne Detaillösung und abhängig davon, wie die Datenstruktur aufgebaut ist.
Gruß, Daniel

Hi
naja, nicht unbedingt,
man kann es zwar so machen, aber wozu?
speichere doch den kleinsten Abstandswert in einer Variable ABSmin und vergleiche diesen mit dem aktuell berechneten ABSaktuell.
wenn ABSaktuell kleiner als ABSmin ist, speicherst du wiederrum den akuellen ABC-Wert und schreibst den ABSakuell nach ABSmin
nach dem Schleifendurchlauf schreibst du dann den gespeicherten ABC-Wert zurück.
mein Makro dazu sieht so aus:


Sub Berechnung()
Dim RK 'Koordinaten der Rasterpunkte
Dim RasterABC 'ABC-Werte der Rasterpunkte
Dim PK 'Koordinaten der Datenpunkte
Dim PunktABC 'ABC-Werte der Datenpunkte
Dim p As Long, r As Long 'Schleifenzähler für Datenpunkte und Rasterpunkte
Dim ABSaktuell As Double, ABSmin As Double
Dim Rmin As Long
'--- Daten aus der Tabelle in Array-Variablen übernehmen
RK = Sheets("Raster").Range("E2:F64")
RasterABC = Sheets("Raster").Range("C2:C64")
PK = Sheets("Punkte").Range("B2:C104")
PunktABC = Sheets("Punkte").Range("D2:D104")
'--- Berechnung durchführen
For p = 1 To UBound(PK, 1)
For r = 1 To UBound(RK)
ABSaktuell = ((RK(r, 1) - PK(p, 1)) ^ 2 + (RK(r, 2) - PK(p, 2)) ^ 2) ^ 0.5
If ABSaktuell

allerdings hab ich mir beide Tabellen in eine Datei geschoben und die Tabellen in die Linke obere Ecke gesetzt, dh. du musst die Zellbezüge noch anpassen.
Gruß, Daniel
btw ich hab gesehen, daß durch den Datentransfer noch NAMEN entstehen, die sich auf deine übertragenen Daten beziehen.
Diese NAMEN könnte man anstelle der Zellbezügen verwenden, so daß sich deine Datei immer automatisch an die übertragene Datenmenge anpassst.
Gruß, Daniel

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread