VBA Makro Optimierung, langer Berechnungsprozess

Guten Tag,
ich habe folgendes Problem:
Ich moechte mithilfe eines Makros die Distanz eines Punktes in einem 2-Dimensionalen Koordinatensystem mit 55000 anderen Punkten vergleichen, und denjenigen Punkt auswaehlen, der diesem am naechsten ist. Dies habe ich mit Schleifen geloest, da mir andere Loesung fuer dafuer unbekannt sind. Das Problem ist leider, dass die Berechnung aufgrund der grossen Menge an Werten mehrere Tage dauern wuerde.
Hier ist mein Code:

Sub PosComparison()
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Remember As Long
Dim time1 As Double
Dim time2 As Double
Dim i As Long
Dim j As Long
time1 = Timer
For i = 1 To 109812
Remember = 1
For j = 1 To 55500
If ((Cells(i, 23).Value - Cells(j + 1, 3).Value) ^ 2) + ((Cells(i, 24).Value - Cells(j + _
1, 4).Value) ^ 2)

Ich wuerde mich ueber jede Hilfe riesig freuen!
Viele Gruesse,
Alex

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo ransi,
das tut mir leid. Wahrscheinlich habe ich mich mit meiner Problemstellung etwas zu kurz gefasst. Die zugehoerigen Werte habe ich nun etwas genauer erklaert s.u. Das Makro hat die Aufgabe die fuer die 114400 Punkte A den am naechsten liegenden Nachbarn der 55000 Punkte B zu finden und dann seine Eigenschaft zusammen mit der eigenen ID von A in die Zeilen 11 und 12 abzulegen. Ich hoffe das hilft ein wenig weiter. :)
Cells(i, 23).Value X-Werte der 114400 Punkte A
Cells(i, 24).Value Y-Werte der 114400 Punkte A
Cells(i, 14).Value Identifikationsnummer der einzelnen Punkte B
Cells(j + 1, 3).Value X-Werte der 55000 zu vergleichenden Punkte B
Cells(j + 1, 4).Value Y-Werte der 55000 zu vergleichenden Punkte B
Cells(Remember + 1, 5).Value Elementeigenschaft der zu vergleichenden Punkte
Cells(i + 1, 11).Value Ausgabeort der Punkt-ID
Cells(i + 1, 12).Value Ausgabeort der Elementeigenschaft
Viele Gruesse,
Alex

Sub PosComparison() Application.EnableEvents = False Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Dim Remember As Long Dim time1 As Double Dim time2 As Double Dim i As Long Dim j As Long Dim arr time1 = Timer arr = Cells(1, 1).Resize(109812, 24) For i = 1 To UBound(arr) Remember = 1 For j = 1 To 55500 If _ ((arr(i, 23) - arr(j + 1, 3)) ^ 2) _ + ((arr(i, 24) - arr(j + 1, 4)) ^ 2)

Beliebteste Forumthreads (12 Monate)

VBA Makro Optimierung, langer Berechnungsprozess

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread