VB应用-石油地质资料整理

油田开发的过程中有很多的数据，在应用不同的软件工具的时候需要整理成不同的格式！各个油田的数据格式不同，各个软件工具的输入要求不同，这也就是至今为什么没有一个能应用很广泛的进行数据格式转换的工具的原因！但是很多技巧我们自己却能很快掌握，让工作效率提高N倍！例子：注释：我编写这段代码只用了十几分钟，可是写这篇技术文章却花了半天，哈哈！为人民服务了！这里有某油田的数据一份，数据保存在一个Excel表中，打开Excel后浏览数据，Excel中有三个Sheet表，分别是Sheet1、Sheet2和Sheet3，其中数据存放在Sheet1中。数据主要是每口井的单砂体分层情况以及单砂体的物性数据。数据如下图所示：数据一共9列，从A列到I列，分别是井名、顶深、底深、砂厚、有效厚度、孔隙度、渗透率、含油饱和度、解释结论；数据共8605行，一共有1百多口井，具体井数没有计算（如果想知道数数也行，不过太浪费时间，自己能计算出来，，稍候便知）。最终想得到每口井一个的文本文件，而且是用空格分隔的，要求第二列不仅是顶深，还要加上底深，也就是把第三列的底深，插入到第二列中，使第二列形成顶深底延续的数据，而且底深对应的物性也要复制过来；同时，层和层之间的隔层段也要加进来！这么说太麻烦，看看最后形成的文件就知道了：这就是最后形成的文件。开始工作了，我们要在Excel中打开一个VB编辑器：Excel菜单栏==〉工具==〉宏==〉VisualBasic编辑器，界面如图：在编辑器的菜单栏中选择“插入”==〉模块，界面变成如下情况：这样我们就可以在界面的主编辑窗口开始编写我们的程序了。首先我们统计有多少口井，同时确定，每口井的开始行号和结束行号：Submacro1()'统计相同井名字的对应行号'从第几行到第几行是一口井DimiAsIntegerDimjAsIntegerj=1’把统计好的数字放在第一行开始Fori=2To8605’确定循环从Sheet1的第2行到第8605行，也就是全部数据的范围IfSheet1.Cells(i,1)Sheet1.Cells(i+1,1)ThenSheet2.Cells(j,2)=i‘每口井结束的行号放到Sheet2中的第2列j=j+1EndIfNextiEndSub编写好后如图：运行后得到Sheet2终得数据，能确定共115行，也就是共115口井我们把每口井的开始行号也添加进取，很简单，就是上一口井的结束行号加上1就是下一口井的开始行号，第一口井的开始行号当然是2，因为在Sheet1里就是从第二行开始的，得到每口井的开始和结束的行号如下图：然后我们要建立和井名字一样多的Sheet表，这样才能把每口井的数据从Sheet1里面复制出来，同样在编辑器里我们开始编写一个新的宏代码（代码是以Sub宏名字（）开始，以EndSub结束）：Submacro2()'添加空白的Sheet表'根据井数添加DimiAsIntegerFori=3To117‘因为一共有115口井Sheet1和Sheet2已经占用，所以要添加到117Sheets(i).SelectSheets.AddSheets(i+1).SelectSheets(i+1).MoveAfter:=Sheets(i)NextiEndSub添加代码后编辑器应该如下：继续在编辑器中填写代码：Submacro3()'将每口井单独放到一个Sheet表里DimiAsIntegerDimrAsIntegerDimcAsIntegerDimjAsIntegerj=3Fori=1To115r=Sheet2.Cells(i,1)c=Sheet2.Cells(i,2)Sheet1.SelectSheet1.ActivateRange(A&r&:&I&c).SelectSelection.CopySheets(j).SelectSheets(j).ActivateRange(A1).SelectActiveSheet.PasteSheets(j).Name=Sheets(j).Cells(1,1)j=j+1NextiEndSub这段代码的意思就是将Sheet1中每口井的数据复制到相应的sheet表中，而且每个Sheet标的名字不再是SheetX，而是对应的井名字，如果学过VB的人应该很明白这段代码的意思啦！^-^这段代码填写后如图：赶快运行一下子来看看，哈哈！这就是运行的结果啦，每口井形成了一个单独的Sheet表，而且Sheet的名字也是对应得井名字，这是效率高！不要忘记我们最终的目的要得到什么样的文件，现在已经一步步在逼近！虽然得到了单独的文件，但是现在还不能够导出，我们要把顶底深度都放到同一列，还要插入隔层段，真是够麻烦的了！好了，不发牢骚了，我们继续编写代码：Submacro4()'为每一个Sheet表插入相应的空白行以此用来添加底深DimiAsIntegerDimjAsIntegerDimkAsIntegerDimxAsIntegerForj=3To117Sheets(j).SelectSheets(j).Activatei=1DoWhileSheets(j).Cells(i,1)i=i+1Loopx=i-1Fork=2To2*xStep2Rows(k&:&k).SelectSelection.InsertShift:=xlDownNextkNextjEndSub填写好后如图：这段代码就是插入空白行，为了放数据用，这个目的是一定要明白的！运行看看！这次运行应该比较慢，不过也就3秒钟：每个数据表都是这样了，这样我们就能把底深复制到对应的空白处，同样物性数据也能！Submacro5()'为插入的行添加数据DimiAsIntegerDimjAsIntegerDimkAsIntegerDimxAsIntegerForj=3To117Sheets(j).SelectSheets(j).Activatei=2‘dowhile是为了检测每个Sheet里存在的行数DoWhileSheets(j).Cells(i+1,1)i=i+2Loopx=iFork=2ToxStep2Sheets(j).Cells(k,1)=Sheets(j).Cells(k-1,1)Sheets(j).Cells(k,2)=Sheets(j).Cells(k-1,3)Sheets(j).Cells(k,4)=Sheets(j).Cells(k-1,4)Sheets(j).Cells(k,5)=Sheets(j).Cells(k-1,5)Sheets(j).Cells(k,6)=Sheets(j).Cells(k-1,6)Sheets(j).Cells(k,7)=Sheets(j).Cells(k-1,7)Sheets(j).Cells(k,8)=Sheets(j).Cells(k-1,8)Sheets(j).Cells(k,9)=Sheets(j).Cells(k-1,9)NextkNextjEndSub同样这段代码添加好后运行，可以看到插入的空白行已经按照设想的把数据复制好了。界面我就不粘贴了！然后再添加代码：Submacro6()'插入空白行用来添加隔层层段Forj=3To117Sheets(j).SelectSheets(j).Activatei=1DoWhileSheets(j).Cells(i,1)i=i+1Loopx=i-1Fork=3To4*xStep4Rows(k&:&k).SelectSelection.InsertShift:=xlDownSelection.InsertShift:=xlDownNextkNextjEndSub这段代码和macro4()的作用相同，macro4()是插入一行空白，而这里是插入两行空白，目的是为了存放隔层段的顶底，在编辑器里填写好后运行看看，千万不要把判断每个Sheet表里存在多少行数据的DoWhile循环搞错！得到的应该是这个样子地：不过这段代码运行的时间的确很长，估计用了将近2分钟，不过比起自己一行一行的添加那绝对不是什么问题，如果115口井手动操作估计2分钟会变成2天，每个Sheet表里的空白行都插入好了，接下来把隔层的顶底计算出来，隔层的顶深无非就是上个砂层的底+0.1米，而底深也就是下个砂层的顶-0.1米，而物性全部给0就可以了，根据这些填写代码：Submacro7()DimiAsIntegerDimjAsIntegerDimkAsIntegerDimxAsIntegerForj=3To117Sheets(j).SelectSheets(j).Activatei=4DoWhileSheets(j).Cells(i+2,1)i=i+4Loopx=i-2Fork=3ToxStep4Sheets(j).Cells(k,1)=Sheets(j).Cells(k-1,1)'wellnameSheets(j).Cells(k+1,1)=Sheets(j).Cells(k-1,1)'wellnameSheets(j).Cells(k,2)=Sheets(j).Cells(k-1,2)+0.1'topSheets(j).Cells(k+1,2)=Sheets(j).Cells(k+2,2)-0.1'bottomSheets(j).Cells(k,4)=0Sheets(j).Cells(k+1,4)=0Sheets(j).Cells(k,5)=0Sheets(j).Cells(k+1,5)=0Sheets(j).Cells(k,6)=0'porSheets(j).Cells(k+1,6)=0Sheets(j).Cells(k,7)=0'permSheets(j).Cells(k+1,7)=0Sheets(j).Cells(k,8)=0'soSheets(j).Cells(k+1,8)=0Sheets(j).Cells(k,9)=0'jlSheets(j).Cells(k+1,9)=0NextkNextjEndSub运行后得到每个Sheet表里都是这种形式的数据：剩下的工作就是导出了填写代码：Submacro8()DimjAsIntegerForj=3To117Sheets(j).SelectSheets(j).ActivateRange(A1).SelectChDirE:\TEMP\temp'想要保存到的路径随时改变ActiveWorkbook.SaveAsFilename:=E:\TEMP\temp\&Sheet2.Name&.prn,FileFormat:=_xlTextPrinter,CreateBackup:=FalseNextjEndSub路径是事先建立好的一个文件夹，在我这里是E盘上的TEMP文件夹里的temp文件夹，也就是导出后的文件放在这个文件夹里。运行后得到的文件就是我们想要的结果了。随便打开一个看看：总算写完了，学习VBA对做石油地质技术的人来说，还是蛮有用处的，希望大家能有时间看看！