Hallo,
Ich habe gerade einen Auftrag bekommen, den Folgenden Visual Basic Code für eine Access Datennbank zu überprüfen, da er anscheinend nicht trichtig funktioniert, kann aber jetzt keinen Fehler finden. (Habe auch noch nicht alzuviel mit Visualbasic programmiert und wenn, dann sehr simple Programme...) Kann jemand den verbessern?
Der Code ist folgender:
Option Compare Database
Sub test()
Dim lng, lat As Single
Dim max_lng, max_lat As Single
Dim min_lng, min_lat As Single
Dim rst_apt As Recordset
Set rst_apt = CurrentDb.OpenRecordset(" select max(lng) as max_lng,
min(lng) as min_lng, max(lat) as max_lat, min(lat) as min_lat from
apt_site1")
rst_apt.MoveFirst
max_lat = Round(rst_apt("max_lat") + 0.5)
min_lat = Round(rst_apt("min_lat") - 0.5)
max_lng = Round(rst_apt("max_lng") + 0.5)
min_lng = Round(rst_apt("min_lng") - 0.5)
For lat = min_lat To max_lat Step 0.5
For lng = min_lng To max_lng Step 0.5
Call erstellen_importdaten(lat, lat + 0.5, lng, lng + 0.5)
Next
Next
End Sub
Sub erstellen_importdaten(ByVal min_lat, ByVal max_lat, ByVal min_lng, ByVal max_lng As Single)
Dim rst_imp As Recordset
Dim rst_apt As Recordset
Dim rst_bna As Recordset
Dim rst_pruef As Recordset
Dim rst_log As Recordset
Dim diff As Double
Dim band As String
Dim str_selectapt As String
Dim str_selectbnetza As String
Dim str_filter1, str_filter2, str_filter3 As String
Dim i As Integer
Dim mindelta As Integer
str_selectapt = Replace("select * from apt_site1 where ((lng > "
& min_lng & ") and (lng <= " & max_lng & _
" ) and (lat > " & min_lat & ") and (lat <= " &
max_lat & "))" _
, ",", ".")
str_selectbnetza = Replace("select * from bnetza_bandinfo where
((sid_long > " & min_lng - mindelta / 3600 & ") and (sid_long
<= " & max_lng + mindelta / 3600 & _
") And (sid_lat > " & min_lat - mindelta / 3600 & ") And
(sid_lat <= " & max_lat + mindelta / 3600 & "))" _
, ",", ".")
Set rst_imp = CurrentDb.OpenRecordset("netsite_import")
Set rst_apt = CurrentDb.OpenRecordset(str_selectapt)
Set rst_bna = CurrentDb.OpenRecordset(str_selectbnetza)
Set rst_log = CurrentDb.OpenRecordset("log")
i = 0
rst_log.AddNew
rst_log("meldung") = "Start: " & min_lng & " / " & min_lat & "; " & max_lng & " / " & max_lat
rst_log("stamp") = Now
rst_log.Update
' ##### Loop über alle in APT vorhandenen Satndorte
If rst_apt.RecordCount > 0 Then
rst_apt.MoveFirst
Do Until rst_apt.EOF
' ##### Loop über alle BNetzA Banlagenangaben
If rst_bna.RecordCount > 0 Then
rst_bna.MoveFirst
Do Until rst_bna.EOF
' Ermittlung des Abstandes zwischen APT und BNetzA Bandlagenstandortes in Sekunden
diff = Round(Sqr((rst_apt("lng") - rst_bna("sid_long")) ^ 2 +
(rst_apt("lat") - rst_bna("sid_lat")) ^ 2) * 3600, 1)
' Ist der BNetzAStandort zu nahe am APT Standort und sollen die Bandlagen übernommen werden?
If rst_bna("freq_band") < 7.4 Then
mindelta = 10
ElseIf rst_bna("freq_band") < 17 Then
mindelta = 5
ElseIf rst_bna("freq_band") < 39 Then
mindelta = 3
Else
mindelta = 2
End If
If diff < mindelta Then
If rst_bna("EFL_UPPER_LOWER") = "L" Then
band = "LOW"
ElseIf rst_bna("EFL_UPPER_LOWER") = "U" Then
band = "HIGH"
End If
str_filter1 = "select * from netsite_import where " & _
"standort_nr = """ & rst_apt("standort_nr") & """ and " & _
"freq_band = " & rst_bna("freq_band") & " and " & _
"bandlage = """ & band & """"
str_filter1 = Replace(str_filter1, ",", ".")
'rst_imp.FindFirst str_filter1 'And str_filter2 'And str_filter3
Set rst_pruef = CurrentDb.OpenRecordset(str_filter1)
If Not rst_pruef.RecordCount > 0 Then
rst_imp.AddNew
rst_imp("standort_nr") = rst_apt("standort_nr")
rst_imp("Mobilfunkbetreiber") = "BNetzA"
rst_imp("FREQ_BAND") = rst_bna("freq_band")
rst_imp("bandlage") = band
rst_imp("lng") = rst_apt("lng")
rst_imp("lat") = rst_apt("lat")
rst_imp("DIFF") = rst_bna("AD_MAN_NUMBER") & "(" & diff & ")"
rst_imp.Update
Else
rst_pruef.MoveFirst
If InStr(1, rst_pruef("DIFF"), rst_bna("AD_MAN_NUMBER") & "(" & diff & ")") = 0 Then
rst_pruef.Edit
rst_pruef("DIFF") = Left(rst_pruef("DIFF") & "; " &
rst_bna("AD_MAN_NUMBER") & "(" & diff & ")", 255)
rst_pruef.Update
End If
End If
End If
rst_bna.MoveNext
Loop
End If
rst_log.AddNew
rst_log("meldung") = "NE: " & rst_apt("standort_nr")
rst_log("stamp") = Now
rst_log.Update
rst_apt.MoveNext
i = i + 1
Loop
End If
rst_log.AddNew
rst_log("meldung") = "Ende: " & min_lng & " / " & min_lat
& "; " & max_lng & " / " & max_lat & "(" & i
& ")"
rst_log("stamp") = Now
rst_log.Update
End Sub
verschoben
Ich habe gerade einen Auftrag bekommen, den Folgenden Visual Basic Code für eine Access Datennbank zu überprüfen, da er anscheinend nicht trichtig funktioniert, kann aber jetzt keinen Fehler finden. (Habe auch noch nicht alzuviel mit Visualbasic programmiert und wenn, dann sehr simple Programme...) Kann jemand den verbessern?
Der Code ist folgender:
Option Compare Database
Sub test()
Dim lng, lat As Single
Dim max_lng, max_lat As Single
Dim min_lng, min_lat As Single
Dim rst_apt As Recordset
Set rst_apt = CurrentDb.OpenRecordset(" select max(lng) as max_lng,
min(lng) as min_lng, max(lat) as max_lat, min(lat) as min_lat from
apt_site1")
rst_apt.MoveFirst
max_lat = Round(rst_apt("max_lat") + 0.5)
min_lat = Round(rst_apt("min_lat") - 0.5)
max_lng = Round(rst_apt("max_lng") + 0.5)
min_lng = Round(rst_apt("min_lng") - 0.5)
For lat = min_lat To max_lat Step 0.5
For lng = min_lng To max_lng Step 0.5
Call erstellen_importdaten(lat, lat + 0.5, lng, lng + 0.5)
Next
Next
End Sub
Sub erstellen_importdaten(ByVal min_lat, ByVal max_lat, ByVal min_lng, ByVal max_lng As Single)
Dim rst_imp As Recordset
Dim rst_apt As Recordset
Dim rst_bna As Recordset
Dim rst_pruef As Recordset
Dim rst_log As Recordset
Dim diff As Double
Dim band As String
Dim str_selectapt As String
Dim str_selectbnetza As String
Dim str_filter1, str_filter2, str_filter3 As String
Dim i As Integer
Dim mindelta As Integer
str_selectapt = Replace("select * from apt_site1 where ((lng > "
& min_lng & ") and (lng <= " & max_lng & _
" ) and (lat > " & min_lat & ") and (lat <= " &
max_lat & "))" _
, ",", ".")
str_selectbnetza = Replace("select * from bnetza_bandinfo where
((sid_long > " & min_lng - mindelta / 3600 & ") and (sid_long
<= " & max_lng + mindelta / 3600 & _
") And (sid_lat > " & min_lat - mindelta / 3600 & ") And
(sid_lat <= " & max_lat + mindelta / 3600 & "))" _
, ",", ".")
Set rst_imp = CurrentDb.OpenRecordset("netsite_import")
Set rst_apt = CurrentDb.OpenRecordset(str_selectapt)
Set rst_bna = CurrentDb.OpenRecordset(str_selectbnetza)
Set rst_log = CurrentDb.OpenRecordset("log")
i = 0
rst_log.AddNew
rst_log("meldung") = "Start: " & min_lng & " / " & min_lat & "; " & max_lng & " / " & max_lat
rst_log("stamp") = Now
rst_log.Update
' ##### Loop über alle in APT vorhandenen Satndorte
If rst_apt.RecordCount > 0 Then
rst_apt.MoveFirst
Do Until rst_apt.EOF
' ##### Loop über alle BNetzA Banlagenangaben
If rst_bna.RecordCount > 0 Then
rst_bna.MoveFirst
Do Until rst_bna.EOF
' Ermittlung des Abstandes zwischen APT und BNetzA Bandlagenstandortes in Sekunden
diff = Round(Sqr((rst_apt("lng") - rst_bna("sid_long")) ^ 2 +
(rst_apt("lat") - rst_bna("sid_lat")) ^ 2) * 3600, 1)
' Ist der BNetzAStandort zu nahe am APT Standort und sollen die Bandlagen übernommen werden?
If rst_bna("freq_band") < 7.4 Then
mindelta = 10
ElseIf rst_bna("freq_band") < 17 Then
mindelta = 5
ElseIf rst_bna("freq_band") < 39 Then
mindelta = 3
Else
mindelta = 2
End If
If diff < mindelta Then
If rst_bna("EFL_UPPER_LOWER") = "L" Then
band = "LOW"
ElseIf rst_bna("EFL_UPPER_LOWER") = "U" Then
band = "HIGH"
End If
str_filter1 = "select * from netsite_import where " & _
"standort_nr = """ & rst_apt("standort_nr") & """ and " & _
"freq_band = " & rst_bna("freq_band") & " and " & _
"bandlage = """ & band & """"
str_filter1 = Replace(str_filter1, ",", ".")
'rst_imp.FindFirst str_filter1 'And str_filter2 'And str_filter3
Set rst_pruef = CurrentDb.OpenRecordset(str_filter1)
If Not rst_pruef.RecordCount > 0 Then
rst_imp.AddNew
rst_imp("standort_nr") = rst_apt("standort_nr")
rst_imp("Mobilfunkbetreiber") = "BNetzA"
rst_imp("FREQ_BAND") = rst_bna("freq_band")
rst_imp("bandlage") = band
rst_imp("lng") = rst_apt("lng")
rst_imp("lat") = rst_apt("lat")
rst_imp("DIFF") = rst_bna("AD_MAN_NUMBER") & "(" & diff & ")"
rst_imp.Update
Else
rst_pruef.MoveFirst
If InStr(1, rst_pruef("DIFF"), rst_bna("AD_MAN_NUMBER") & "(" & diff & ")") = 0 Then
rst_pruef.Edit
rst_pruef("DIFF") = Left(rst_pruef("DIFF") & "; " &
rst_bna("AD_MAN_NUMBER") & "(" & diff & ")", 255)
rst_pruef.Update
End If
End If
End If
rst_bna.MoveNext
Loop
End If
rst_log.AddNew
rst_log("meldung") = "NE: " & rst_apt("standort_nr")
rst_log("stamp") = Now
rst_log.Update
rst_apt.MoveNext
i = i + 1
Loop
End If
rst_log.AddNew
rst_log("meldung") = "Ende: " & min_lng & " / " & min_lat
& "; " & max_lng & " / " & max_lat & "(" & i
& ")"
rst_log("stamp") = Now
rst_log.Update
End Sub
verschoben
Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „FlashTek“ ()