“耍赖的”数据加载（Petrel）

tianyingzuonb

Joseph 发表于 2014-3-12 12:39
老实说对于此类问题我现在学乖了不少，就是上网上搜索一下VBA，看看“export all sheets”，成筐的代码 ...

谢谢郝老师答疑解惑，软件能用~经验证！而且还有其他的功能~

773377

直接用计算器，新建某某曲线等于零，再开spreadshee粘贴不就完了么，还省一步。计算器里直接可以选template。

Joseph

773377 发表于 2014-3-13 11:03
直接用计算器，新建某某曲线等于零，再开spreadshee粘贴不就完了么，还省一步。计算器里直接可以选template ...

773377，谢谢你的提醒，这个方法确实可行。

不过，这个操作过程并不比我建议的生成新曲线的方法快捷。因为实际操作中Petrel使用Calculator做曲线计算要么依附于某条存在曲线采样，要么按照等间隔采样。这样，你在大开Spreadsheet进行拷贝复制之前要删除原来的伪造的“零”数据。

Where_and_When

可不可以分层数据也用类似的方法直接复制过来？我试了试，没有成功，

Joseph

Where_and_When 发表于 2014-3-17 10:59
可不可以分层数据也用类似的方法直接复制过来？我试了试，没有成功，

这个我也是经常耍赖的，尤其是后来随时追加的一两口井的情况居多。

新版本的Petrel（大约2005版本以后？）对于Welltops的管理比较严格，需要提前在Horizons里设置好各分层名字，然后才能粘贴进Spreadsheet，如果是新加载Welltops用粘贴的办法不怎么方便。

数据粘贴三列：Well Name、Horizon Name和 MD（测量深度）。TVD（垂直真深度）方式需要同时提供XY坐标，不推荐。

西北男儿

恩！厉害。。。

renxiaohuaren

cnelecn

Joseph 发表于 2014-3-17 12:59
这个我也是经常耍赖的，尤其是后来随时追加的一两口井的情况居多。

新版本的Petrel（大约2005版本以 ...

周末抽空弄了各welltop的vba，给工作带了方便，分享一下。欢迎批评指正。


代码：

Sub 按钮1_Click()
Dim str As String
Dim iRow, iColumn As Integer
Dim Source

Source = ActiveSheet.UsedRange

Open ThisWorkbook.Path & "\Welltops FromExcel.txt" For Output As #1

'【header】


    str = str & "# Petrel well tops by Guochen" & Chr(13) & Chr(10)
    str = str & "# Unit in X and Y direction: m" & Chr(13) & Chr(10)
    str = str & "# Unit in depth: m" & Chr(13) & Chr(10)
    str = str & "Version 2" & Chr(13) & Chr(10)
    str = str & "BEGIN Header" & Chr(13) & Chr(10)
    str = str & "MD" & Chr(13) & Chr(10)
    str = str & "Type" & Chr(13) & Chr(10)
    str = str & "Surface" & Chr(13) & Chr(10)
    str = str & "Well" & Chr(13) & Chr(10)
    str = str & "END HEADER" & Chr(13) & Chr(10)




'【content】

    For iRow = 2 To UBound(Source)

        For iColumn = 2 To UBound(Source, 2)




            str = str & CheckValue(ActiveSheet.Cells(iRow, iColumn)) & vbTab
            str = str & Horizon & vbTab & ActiveSheet.Cells(1, iColumn) & vbTab & ActiveSheet.Cells(iRow, 1) & vbTab
            str = str & Chr(13) & Chr(10)



        Next


    Next

    Print #1, str

    Close #1

End Sub


Function CheckValue(strValue As String) As String

'   空值替换
    If Len(strValue) < 1 Then
        CheckValue = "-999"
    Else
        CheckValue = strValue
    End If

End Function

大海的家

好东西啊 啊  啊飞