2024-01-15 18:21来源:m.sf1369.com作者:宇宇
Sub test()
Application.ScreenUpdating = False
Dim f, wb, x
f = Application.GetOpenFilename(EXCEL文件,*.*,, 1, MultiSelect:=True)
For x = 1 To UBound(f)
Set wb = Workbooks.Open(f(x))
Workbooks(工作簿1.xlsm).Sheets(1).Range(a1:j3).Copy wb.Sheets(2).Range(a1) '复制标题
wb.Sheets(2).Range(a4) = wb.Sheets(1).Range(a2) '找区站号
wb.Sheets(1).Columns(D:E).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove '插入列
wb.Sheets(1).Range(d2:d & Range(c10000).End(3).Row) = 1 'C列
Dim y
For y = 2 To wb.Sheets(1).Range(c10000).End(3).Row
wb.Sheets(1).Cells(y, 5) = VBA.DateSerial(Cells(y, 2), Cells(y, 3), Cells(y, 4))
wb.Sheets(1).Cells(y, e).NumberFormatLocal = 00000
Next y
wb.Sheets(2).Range(b4) = =SUMPRODUCT((Sheet1!$E$2:$E$1500>=B1)*(Sheet1!$E$2:$E$1500<=B2)*(Sheet1!$F$2:$F$1500))/SUMPRODUCT((Sheet1!$E$2:$E$1500>=B1)*(Sheet1!$E$2:$E$1500<=B2))
wb.Sheets(2).Range(b4:j4).FillRight
wb.Sheets(2).Range(a4:j4).Copy
Workbooks(工作簿1.xlsm).Sheets(1).Range(a1000).End(3).Offset(1, 0).PasteSpecial (xlPasteValues) '
wb.Close False
Next x
Application.ScreenUpdating = True
MsgBox 处理完成,请查看!
End Sub
首先是4个栅格数据DEM(数字高程模型)和MASK(掩膜),之后是landuse(土地利用数据)和soil(土壤属性数据);
之后是DBF表和文本文件:河道径流测站位置表、营养物监测站位置表、降水测站位置表、降水数据表、气温测站位置表、气温数据表、用来创建自定义气象生成器数据集的气象站位置表、土地利用索引表、土壤索引表,以及土地利用索引文本和土壤索引文本文件。