Rigaku XRDのrasファイル処理

RigakuのXRDを使っているが、出力されるrasファイルの中身が実際にはただのテキストファイルなので、それを読み込んでまとめてしまうマクロを作ろうと思っている。
解析は専用の解析ソフトがあるのだが、なんとなく画面キャプチャではなく、グラフはエクセルで書いて出そうなんて思っている。

rasファイルのフォーマットは

*RAS_DATA_START
*RAS_HEADER_START
*DISP_FMT_X "%.2f"
*DISP_FMT_Y "%.0f"

～中略～

*MEAS_SCAN_UNIT_X "deg"
*MEAS_SCAN_UNIT_Y "counts"
*RAS_HEADER_END
*RAS_INT_START
30.0000 877.0000 1.0000
30.0100 911.0000 1.0000

～測定データが続く～

79.9900 189.0000 1.0000
80.0000 189.0000 1.0000
*RAS_INT_END
*RAS_DATA_END

 

というようなファイル形式となっている。

測定データ以外の行は＊で始まるので、これ以外の行の数字を処理していく。

データの並びは、

2θ 検出X線強度 アッテネータ減衰率

の並びであるので、出力としては

2θ, 検出X線強度×アッテネータ減衰率を出力すればよい。

 

 作ったコードはこんな感じ。5000点あるデータを12個処理するのに5秒くらいかかる鈍足だが、手でやるよりは早い。

Private Sub CommandButton1_Click()
Dim TwoTheta() As Double
Dim XrayIntensity() As Double
Dim FileName
Dim FileNames
Dim i As Long
Dim j As Long
Dim T1 As Double
Dim T2 As Double

ChDrive ThisWorkbook.Path


'複数のファイルを開く
FileNames = Application.GetOpenFilename("RAS File,*.ras", , , , True)
'キャンセルのとき、Booleanが帰ってくるので、Variant()のときだけ処理実行
If TypeName(FileNames) <> "Variant()" Then
    Exit Sub
End If

Application.ScreenUpdating = False

T1 = Timer()

'マクロに値を出力したくないので新しいワークブックを作る
Workbooks.Add
With ActiveWorkbook.Sheets(1)

j = 2

For Each FileName In FileNames  'ファイル名ごとに中身を調べていく
    
    Call LoadRasFile(FileName, TwoTheta(), XrayIntensity)
        .Cells(2, j + 1) = GetFileNameOnly(FileName)    'ファイル名を出力しておく
        For i = 1 To UBound(TwoTheta())                 '値の出力
            .Cells(i + 2, j) = TwoTheta(i)
            .Cells(i + 2, j + 1) = XrayIntensity(i)
        Next i
    j = j + 2
Next FileName
End With

T2 = Timer()
Application.ScreenUpdating = True
Application.StatusBar = "処理時間=" & Format(T2 - T1, "0.00") & "[s]"
  
End Sub
Function GetFileNameOnly(FullPath) As String
'ファイルのフルパスからファイル名のみを取り出す
GetFileNameOnly = Right(FullPath, Len(FullPath) - InStrRev(FullPath, "\"))  '最後の\より右側を取り出す
GetFileNameOnly = Left(GetFileNameOnly, InStrRev(GetFileNameOnly, ".") - 1)    '拡張子のピリオドで切り落とす

End Function

Sub LoadRasFile(FileName, ByRef TwoTheta() As Double, ByRef XrayIntensity() As Double)
'rasファイルの中身を読み込んでくる。TwoThetaに2θを、XrayIntensityにX線強度を格納する。
Dim TempString As String
Dim SplitedTempString() As String
Dim Fn As Integer
Dim i As Long
i = 1

Fn = FreeFile
Open FileName For Input As #Fn
    
    '■ヘッダ読み飛ばし
    Do
        Line Input #Fn, TempString
    Loop While Left(TempString, 1) = "*"
    
    
    '■データ読み込み
    Do
        SplitedTempString = Split(TempString, " ")
           
        ReDim Preserve TwoTheta(i)
        ReDim Preserve XrayIntensity(i)
        
        TwoTheta(i) = Val(SplitedTempString(0))
        XrayIntensity(i) = Val(SplitedTempString(1)) * Val(SplitedTempString(2))
        
        Line Input #Fn, TempString
        SplitedTempString = Split(TempString, " ")
                
        i = i + 1
        
    Loop Until Left(TempString, 1) = "*"
    
Close Fn
End Sub