Verschachtelung
18.02.2007 01:49:21
Uwe
folgende Ausgangssituation:
in einer Liste (Tabellenblatt 1) sind Mitgliederdaten inkl. Adressen vorhanden. Über die folgende Funktion (Auszug) soll die Entfernung zwischen einem Punkt X und der jeweiligen Adresse über die PLZ ermittelt werden. Alle Adressen, die in einem bestimmten Radius liegen werden auf ein neues Tabellenblatt kopiert.
Eine Referenztabelle (Tabellenblatt 2) hält die Längen- und Breitengrade der PLZ vor. Im Tabellenblatt 1 befindet sich nur die PLZ.
Mein Problem ist die verschachtelte Funktion, bez. die richtige Übergabe der Werte aus getCoordinates zur getDistance
Bin für jede noch so kleine Hilfe dankbar!!!
Viele Grüße
Uwe
Private Sub Test()
Dim counter As Integer
Dim lon As Double
Dim lat As Double
Dim lonPPP As Double
Dim latPPP As Double
Dim userData As Range
counter = 0
'Fiktive Werte - Eigentlich wird hier eine Funktion aufgerufen, mit der die Grade eines Punktes X bestimmt werden
lon = 2.02
lat = 10.02
'Suchbereich - Spalte mit Postleitzahlen
Set userData = ThisWorkbook.Worksheets(1).Range("n2:n20")
For int2Row = 1 To userData.Rows.Count
'Hier liegt mein Problem: Muss getDistance mit den Rückgabewerten von getCoordinates füttern
If CInt(getDistance(lat, lon, getCoordinates Trim(userData.Cells(in2Row, 14).Value), lonPPP, latPPP)) <= Trim(TextBox2.Value) Then
counter = counter + 1
If counter = 1 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
ThisWorkbook.Worksheets(Worksheets.Count).Name = Trim(TextBox1.Value) & " - " & Trim(TextBox2.Value) & " km Radius"
End If
ThisWorkbook.Worksheets(1).Rows(int2Row).Copy Destination:=ThisWorkbook.Worksheets(Worksheets.Count).Rows(counter)
End If
Next int2Row
Unload Me
End Sub
'Hier wird auf ein zweites Blatt mit Postleitzahlen (Spalte 1) und Längen- und Breitengraden (2 und 3) zugegriffen
Private Sub getCoordinates(ByVal zipCode As String, ByRef longitudePPP As Double, ByRef latitudePPP As Double)
Set geoDataPPP = ThisWorkbook.Worksheets(2).Range("A1:C9000")
For int2Row = 1 To geoDataPPP.Rows.Count
If Trim(zipCode) = Trim(geoDataPPP.Cells(int2Row, 1).Value) Then
longitudePPP = geoDataPPP.Cells(int2Row, 2) / 10000
latitudePPP = geoDataPPP.Cells(int2Row, 3) / 10000
End If
Next int2Row
End Sub
Private Function getDistance(ByVal pt1_lat As Double, ByVal pt1_lon As Double, ByVal pt2_lat As Double, ByVal pt2_lon As Double) As Double