| 查看: 558 | 回复: 1 | |||
askding金虫 (小有名气)
|
[求助]
环境风险评价及作图请教
|
|
想做一个环境风险评价的图，使用VBA编程看的不是很懂，有人能帮助下吗？ 我试着编了下，求高人帮我看下编的对吗？ 如下：在评价区域内，将区域污染源可能影响区域14km×14km的范围网格化，取步长为500 m，形成29行29列的网格。在每个网格对7个源的扩散后的风险值进行迭加得到总和r。然后在Excel中将网格的数据转成X/Y/Z格式。具体编程如下：Sub 环境风险评价() Dim k As Integer, j As Integer, i As Integer, x As Integer, y As Integer, m As Integer, n As Integer, d1 As Integer, d2 As Integer, d3 As Integer, d4 As Integer, d5 As Integer, d6 As Integer, d7 As Integer, r1 As Double, r2 As Double, r3 As Double, r4 As Double, r5 As Double, r6 As Double, r7 As Double , rr As Double k=0'定义X轴最小值 For j= 2 To 30 Sheet1.Cells(1,j)=k k=k+50 '间隔为500m（将实际距离换算成相对坐标系下的距离长度，实际为500m，坐标下为50m） Next k=1400 'Y轴最大值 For j=2 To 30 Sheet1.Cells(j,1)=k k=k-50 Next x=0 For m=2 To 30 y=1400 For n=2 To 30 Sheet1.Cells(n,m)=Sqr((705-x)^2+(652-y)^2)'输入源1坐标 Sheet1.Cells(n+30,m)=Sqr((690-x)^2+(523-y)^2)'输入源2坐标 Sheet1.Cells(n+60,m)=Sqr((769-x)^2+(416-y)^2)'输入源3坐标 Sheet1.Cells(n+90,m)=Sqr((552-x)^2+(682-y)^2)'输入源4坐标 Sheet1.Cells(n+120,m)=Sqr((758-x)^2+(815-y)^2)'输入源5坐标 Sheet1.Cells(n+150,m)=Sqr((894-x)^2+(983-y)^2)'输入源6坐标 Sheet1.Cells(n+180,m)=Sqr((667-x)^2+(381-y)^2)'输入源7坐标 y=y-50 Next x=x+50 Next For m=2 To 30 For n=2 To 30 d1=Sheet1.Cells(n,m)'表示距离 d2=Sheet1.Cells(n+30,m) d3=Sheet1.Cells(n+60,m) d4=Sheet1.Cells(n+90,m) d5=Sheet1.Cells(n+120,m) d6=Sheet1.Cells(n+150,m) d7=Sheet1.Cells(n+180,m) r1=(400-d1)/350*8.33*0.00001'风险值计算,需输入影响半径m r2=(400-d2)/350*8.33*0.00001 r3=(400-d3)/ 350*8.33*0.00001 r4=(417-d4)/367*8.08*0.0001 r5=(250-d5)/200*9.16*0.00001 r6=(333-d6)/283*5.7*0.00001 r7=(400-d7)/350*3.72*0.001 Sheet2.Cells(n,m)=r1 If r1<0 Then r1=0 End If Sheet2.Cells(n+30,m)=r2 If r2<0 Then r2=0 End If Sheet2.Cells(n+60,m)=r3 If r3<0 Then r3=0 End If Sheet2.Cells(n+90,m)=r4 If r4<0 Then r4=0 End If Sheet2.Cells(n+120,m)=r5 If r5<0 Then r5=0 End If Sheet2.Cells(n+150,m)=r6 If r6<0 Then r6=0 End If Sheet2.Cells(n+180,m)=r7 If r7<0 Then r7=0 End If Sheet3.Cells(n,m)=rl+r2+r3+r4+r5+r6+r7 Next Next For m=2 To 30 For n=2 To 30 rr=Sheet3.Cells(n,m) If rr>0 Then Sheet5.Cells(n,m)=Int(Log(rr)/Log(10)+8)'转化为小数形式,并存入表单5 Else Sheet5.Cells(n,m)=1 End If Next Next For m=2 To 30 For n=2 To 30 Sheet4.Cells((m-2)*29+n,3)=Sheet5.Cells(n,m)'以YXZ形式存入表单4 Next Next For m=2 To 30 For n=2 To 30 Sheet4.Cells((m-2)*29+n,2)=1400-50*(n-2) Next Next For m=2 To 30 For n=2 To 30 Sheet4.Cells((m-2)*29+n,l)=0+(m-2)*50 Next Next End Sub |
回复此楼» 收录本帖的淘帖专辑推荐
 鐜 |
» 猜你喜欢
法国巴黎地球物理研究所remi marsac研究员招环境地学类CSC博士生
已经有1人回复
-
调剂招生信息，环境专业有名额
已经有2人回复
-
化学工程及工业化学论文润色/翻译怎么收费?
已经有132人回复
-
接受A区环境专业类调剂
已经有10人回复
-
求调剂
已经有0人回复
-
学术/专业硕士调剂——化学、资源与环境
已经有17人回复
-
首次招收资格，招收工科调剂！
已经有10人回复
-
南方油校——资源与环境专硕招生，化学环境生物类专业均可，就业好，有专业壁垒
已经有0人回复
-
沈阳工业大学-环境电化学技术研究团队-招收硕士研究生
已经有7人回复
» 本主题相关价值贴推荐，对您同样有帮助:
- 求教一个画图的问题
已经有5人回复
- matlab三维矩阵绘图请教
已经有6人回复
- 请问大家，毕业论文或者发的文章中的原理图可否引用别人文章中的，还是要自己画图？
已经有8人回复
- origin作图用merge功能把两个图左右拼在一起功能求助
已经有16人回复
- 怎样学习CAD画图？
已经有20人回复
- 【教程】论文科学作图软件Origin全面讲解
已经有1273人回复
- origin画图问题求助
已经有8人回复
- Matlab绘图请教
已经有4人回复
- Origin作图请教
已经有3人回复
- 求助关于不同的作图软件金属配位环境不同
已经有4人回复
- origin 作图坐标轴问题请教
已经有6人回复
- 请教JACS文章上的优美作图方法
已经有11人回复
- 数据绘图问题，请教各位
已经有15人回复
- 【求助】请教报考环境影响评价工程师的条件
已经有10人回复
- 【求助】matlab 绘图问题
已经有16人回复
- 请教一个oringin作图问题
已经有2人回复
- origin 作图请教
已经有7人回复
- 【请教】diamond画图问题
已经有9人回复
- 【其他】Photoshop作图问题
已经有3人回复
- 求助Origin8.0画图的问题
已经有9人回复
askding
金虫 (小有名气)
- 应助: 0 (幼儿园)
- 金币: 1674.1
- 散金: 147
- 红花: 1
- 帖子: 148
- 在线: 122.9小时
- 虫号: 1334113
- 注册: 2011-06-29
- 专业: 景观与区域生态学
2楼2014-03-28 13:51:38
