纯干货！示范程序源程序！

程序运行前需完成如下准备工作：

1、下载原始数据文件，并将解压出相应的数据文件：

h0.txt、R001.TXT和TOPO.dat；

2、本示范程序默认数据文件读取路径为C盘根目录，因此需要将数据文件按原文件名直接拷贝至C盘根目录下，效果截图如下： 

其中：

h0.txt：ITU P.839.4 所附带的数据文件，包含有高于平均海平面的年平均0°C等温线数据。

R001.TXT：ITUP.837.7 所附带的数据文件，包含有超过年平均降雨率0.01%的年降雨率数据。

TOPO.dat：ITUP.1511 所附带的数据文件，包含有海拔数据，

完成上述工作后，打开EXCEL文件，输入经纬度后，点击获取数据即可。注：程序主要示范精确取值功能，因此对所有非网格点数据均采用双插值四点法取值推算，ITU P.1511建议处理海拔数据采用双三插值16点法取值推算。

程序运行效果如下：

相关源程序如下：

Public Bilinear_value As Double

Public Function Bilinear(Row_int,Column_int, Row_frac, Column_frac, Step_1, File_name_1)

Dim Data(2, 2) As Double

Dim Diff_row, Diff_col As Double

Diff_row = Row_int - Row_frac

Diff_col = Column_int - Column_frac

On Error GoTo b

Open File_name_1 For Input As #1

'第一种情况，纬度和经度符合数据库间距，可定位至一个点，直接取该点的值

   If Diff_row = 0 And Dif_Col = 0 Then

       For i = 1 To Row_int - 1

           Line Input #1, test

       Next

       For i = 1 To Column_int - 1

           Input #1, test

       Next

       Input #1, test

       Bilinear_value = Val(test)

         Close #1

       Exit Function

   End If

'第二种情况，纬度符合数据库间距，可定位至两个点，取值并计算

   If Diff_row = 0 Then

       For i = 1 To Row_int - 1

            Line Input #1, test

       Next

       For i = 1 To Column_int - 1

           Input #1, test

       Next

       Input #1, test

       Data(1, 1) = Val(test)

       Input #1, test

       Data(1, 2) = Val(test)

       Bilinear_value = Data(1, 1) * (Diff_col + 1) + Data(1, 2) * (-Diff_col)

        Close #1

       Exit Function

   End If

 '第三种情况，经度符合数据库间距，可定位至两个点，取值并计算

   If Diff_col = 0 Then

       For i = 1 To Row_int - 1

           Line Input #1, test

       Next

       For i = 1 To Column_int - 1

           Input #1, test

       Next

       Input #1, test

       Data(1, 1) = Val(test)

       Line Input #1, test

       For i = 1 To Column_int - 1

           Input #1, test

       Next

       Input #1, test

       Data(2, 1) = Val(test)

       Bilinear_value = Data(1, 1) * (Diff_row + 1) + Data(2, 1) * (-Diff_row)

        Close #1

       Exit Function

   End If

'第四种情况，都不符合数据库间距，定位至四个点，取值并计算

       For i = 1 To Row_int - 1

           Line Input #1, test

       Next

       For i = 1 To Column_int - 1

           Input #1, test

       Next

       Input #1, test

       Data(2, 1) = test

       Input #1, test

       Data(2, 2) = test

       Line Input #1, test

       For i = 1 To Column_int - 1

           Input #1, test

       Next

       Input #1, test

       Data(1, 1) = test

       Input #1, test

       Data(1, 2) = test

       Bilinear_value = Data(1, 1) * (Diff_row + 1) * (Diff_col + 1) + Data(2,1) * (-Diff_row) * (Diff_col + 1) + Data(1, 2) * (1 + Diff_row) * (-Diff_col) +Data(2, 2) * (-Diff_row) * (-Diff_col)

       Close #1

       Exit Function

b:         MsgBox '相关文件不存在！'

 

Bilinear_value = -100

End Function

'-----------

'----修改编辑完成后将下列行替换 Sub 数字地图取值()并将文件另存为 新文件名如 数字地图取值1.0

'Private Sub Auto_open()

Sub 数字地图取值()

   Load UserForm1

   UserForm1.Show

End Sub

 

Private Sub CommandButton1_Click()

Dim Row_int_index, Column_int_index,Row_frac_index, Column_frac_index, Lat, Lon, Lat_trans, Lon_trans, Step AsDouble

Dim File_name As String

Lat = Val(纬度.Value)

Lon = Val(经度.Value)

If Lat > 90 Or Lat < -90 Then

   MsgBox '请检查相关数据！'

   Exit Sub

ElseIf Lon > 180 Or Lon < -180 Then

    MsgBox '请检查相关数据！'

   Exit Sub

End If

'839-降雨高度

Step = 1.5

Lat_trans = Lat

Row_frac_index = (90 - Lat_trans) / Step +1

Row_int_index = Fix((90 - Lat_trans) /Step) + 1

If Lon > 0 Then

   Lon_trans = Lon

Else

   Lon_trans = Lon + 360

End If

Column_frac_index = Lon_trans / Step + 1

Column_int_index = Fix(Lon_trans / Step) +1

File_name = 'C:\h0.txt'

Call Bilinear(Row_int_index,Column_int_index, Row_frac_index, Column_frac_index, Step, File_name)

降雨高度.Value = Int(Bilinear_value *1000) / 1000

If Bilinear_value = -100 Then

   Bilinear_value = ' '

   Exit Sub

End If

'837-降雨量

Step = 0.125

Lat_trans = Lat

Row_frac_index = (90 + Lat_trans) / Step +1

Row_int_index = Fix((90 + Lat_trans) /Step) + 1

Lon_trans = Lon + 180

Column_frac_index = Lon_trans / Step + 1

Column_int_index = Fix(Lon_trans / Step) +1

File_name = 'C:\R001.txt'

Call Bilinear(Row_int_index,Column_int_index, Row_frac_index, Column_frac_index, Step, File_name)

降雨量.Value = Int(Bilinear_value *1000) / 1000

If Bilinear_value = -100 Then

    Bilinear_value = ' '

   Exit Sub

End If

'1511海拔高度

Step = 1 / 12

Lat_trans = Lat + 0.125

Row_frac_index = (90 - Lat_trans) / Step +3

Row_int_index = Fix((90 - Lat_trans) /Step) + 3

Lon_trans = Lon - 0.04166 + 180

Column_frac_index = Lon_trans / Step + 3

Column_int_index = Fix(Lon_trans / Step) +3

File_name = 'C:\TOPO.dat'

Call Bilinear(Row_int_index,Column_int_index, Row_frac_index, Column_frac_index, Step, File_name)

海拔高度.Value = Int(Bilinear_value) /1000

End Sub

 如果大家有问题或者是有不懂得方面欢迎私信一起讨论~