Praatという音声分析ソフトのレポート出力をExcelにまとめたいという要望があり、VBAで作成したので、 ファイル操作やダイアログで複数選ぶ時や文字列を抽出する方法を参考までに。Pulses/Voice Reportの出力は以下の様になっており、 複数のファイルのそれぞれの項目を表にする。ReadFiles()を実行。
-- Voice report for 1. Sound a_1 --
Date: Wed Feb 28 14:37:38 2018
WARNING: some of the following measurements may be imprecise.
For more precision, go to "Pitch settings" and choose "Optimize for voice analysis".
Time range of SELECTION
From 0.040134 to 0.176291 seconds (duration: 0.136157 seconds)
Pitch:
Median pitch: 117.024 Hz
Mean pitch: 118.316 Hz
Standard deviation: 3.136 Hz
Minimum pitch: 114.442 Hz
Maximum pitch: 126.613 Hz
Pulses:
Number of pulses: 16
Number of periods: 15
Mean period: 8.485830E-3 seconds
Standard deviation of period: 0.200097E-3 seconds
Voicing:
Fraction of locally unvoiced frames: 7.143% (1 / 14)
Number of voice breaks: 0
Degree of voice breaks: 0 (0 seconds / 0 seconds)
Jitter:
Jitter (local): 1.051%
Jitter (local, absolute): 89.155E-6 seconds
Jitter (rap): 0.545%
Jitter (ppq5): 0.650%
Jitter (ddp): 1.636%
Shimmer:
Shimmer (local): 7.663%
Shimmer (local, dB): 0.669 dB
Shimmer (apq3): 3.656%
Shimmer (apq5): 5.658%
Shimmer (apq11): 7.601%
Shimmer (dda): 10.969%
Harmonicity of the voiced parts only:
Mean autocorrelation: 0.897243
Mean noise-to-harmonics ratio: 0.174640
Mean harmonics-to-noise ratio: 12.821 dB
Sub ReadFiles()
Dim myFile As Variant
Dim f As Variant
ChDir "C:\"
myFile = Application.GetOpenFilename( _
FileFilter:="テキストファイル (*.txt; *.*),*.txt; *.*", _
MultiSelect:=True)
If IsArray(myFile) Then
For Each f In myFile
Process_File (f)
Next
Else
If myFile <> False Then
Process_File (myFile)
End If
End If
End Sub
Function Process_File(fileName As String)
' MsgBox "以下のファイルを追加：" + fileName
Dim intFF As Integer ' FreeFile値
Dim strREC As String ' 読み込んだレコード内容
Dim GYO As Long ' 収容するセルの行
' １行目生成
Cells(1, 1) = "ファイル名"
Cells(1, 2) = "Jitter (ppq5) (%)"
Cells(1, 3) = "Shimmer (apq5) (%)"
Cells(1, 4) = "Mean harmonics-to-noise ratio (dB)"
' 空行検索
Dim Count As Long
Count = 2
Do Until Cells(Count, 1) = ""
Count = Count + 1
Loop
Cells(Count, 1) = Dir(fileName)
intFF = FreeFile
Open fileName For Input As #intFF
GYO = 1
Do Until EOF(intFF)
Line Input #intFF, strREC
If InStr(strREC, "Jitter (ppq5)") > 0 Then
Cells(Count, 2) = extractStr(strREC, "Jitter (ppq5): ", "%")
End If
If InStr(strREC, "Shimmer (apq5)") > 0 Then
Cells(Count, 3) = extractStr(strREC, "Shimmer (apq5): ", "%")
End If
If InStr(strREC, "Mean harmonics-to-noise ratio") > 0 Then
Cells(Count, 4) = extractStr(strREC, "Mean harmonics-to-noise ratio: ", " dB")
End If
GYO = GYO + 1
Loop
Close #intFF
ProcessFile = Temp
End Function
Function extractStr(rngValue As String, strDel1 As String, strDel2 As String)
Dim startNum As Integer, endNum As Integer
startNum = InStr(rngValue, strDel1) + Len(strDel1) - 1
endNum = InStr(startNum + 1, rngValue, strDel2)
If startNum <> 0 And endNum <> 0 Then
startNum = startNum + 1
extractStr = Mid(rngValue, startNum, endNum - startNum)
Else
extractStr = ""
End If
End Function
以下のように収集される。
| ファイル名 | Jitter (ppq5) (%) | Shimmer (apq5) (%) | Mean harmonics-to-noise ratio (dB) |
| info.txt | 0.65 | 5.658 | 12.821 |
| ... |
項目が多い場合は配列を使うと良い。
Sub ReadFiles()
Dim myFile As Variant
Dim f As Variant
ChDir "C:\"
myFile = Application.GetOpenFilename( _
FileFilter:="テキストファイル (*.txt; *.*),*.txt; *.*", _
MultiSelect:=True)
If IsArray(myFile) Then
For Each f In myFile
Process_File (f)
Next
Else
If myFile <> False Then
Process_File (myFile)
End If
End If
End Sub
Function Process_File(fileName As String)
' MsgBox "以下のファイルを追加：" + fileName
Dim intFF As Integer ' FreeFile値
Dim strREC As String ' 読み込んだレコード内容
Dim GYO As Long ' 収容するセルの行
Dim headList As Variant
headList = Array( _
"Median pitch: ", " Hz", _
"Mean pitch: ", " Hz", _
"Standard deviation: ", " Hz", _
"Minimum pitch: ", " Hz", _
"Maximum pitch: ", " Hz", _
"Jitter (local): ", "%", _
"Jitter (local, absolute): ", " seconds", _
"Jitter (rap): ", "%", _
"Jitter (ppq5): ", "%", _
"Jitter (ddp): ", "%", _
"Shimmer (local): ", "%", _
"Shimmer (local, dB): ", " dB", _
"Shimmer (apq3): ", "%", _
"Shimmer (apq5): ", "%", _
"Shimmer (apq11): ", "%", _
"Shimmer (dda): ", "%", _
"Mean autocorrelation: ", "", _
"Mean noise-to-harmonics ratio: ", "", _
"Mean harmonics-to-noise ratio: ", " dB" _
)
' １行目生成
Cells(1, 1) = "ファイル名"
Length = UBound(headList) - LBound(headList) + 1
For I = 0 To (Length / 2) - 1
Cells(1, I + 2) = headList(I * 2) + headList(I * 2 + 1)
Next I
' 空行検索
Dim Count As Long
Count = 2
Do Until Cells(Count, 1) = ""
Count = Count + 1
Loop
Cells(Count, 1) = Dir(fileName)
intFF = FreeFile
Open fileName For Input As #intFF
GYO = 1
Do Until EOF(intFF)
Line Input #intFF, strREC
For I = 0 To (Length / 2) - 1
If InStr(strREC, headList(I * 2)) > 0 Then
Dim str1 As String
str1 = headList(I * 2)
Dim str2 As String
str2 = headList(I * 2 + 1)
Cells(Count, I + 2) = extractStr(strREC, str1, str2)
End If
Next I
GYO = GYO + 1
Loop
Close #intFF
ProcessFile = Temp
End Function
Function extractStr(rngValue As String, strDel1 As String, strDel2 As String)
Dim startNum As Integer, endNum As Integer
startNum = InStr(rngValue, strDel1) + Len(strDel1) - 1
endNum = InStr(startNum + 1, rngValue, strDel2)
If startNum <> 0 And endNum <> 0 Then
startNum = startNum + 1
extractStr = Mid(rngValue, startNum, endNum - startNum)
If strDel2 = "" And startNum <> 0 Then
extractStr = Mid(rngValue, startNum, Len(rngValue))
End If
Else
extractStr = ""
End If
End Function
Diplomat: A man who always remembers a
woman's birthday but never her age.
-- One of Nadav Har'El's Email Signatures.
<yrlnry> Hi, I heard that Perl is just HTML with some sort of macro
preprocessor attached. So I thought you would be the right
people to ask about whether there is a way to make the
submitted value on an <input type=submit> different from the
visible label on the button.
<yrlnry> Thanks in advance.
* Roderick tars and feathers yrlnry.
<yrlnry> Hi, Roderick! How's the kid?
<Somni> you have been misinformed, sir; Perl is just a regex engine
with named variables
<ne2k__> yrlnry: that is possibly one of the oddest questions I have
ever heard
<yrlnry> ne2k__: What's odd about "How's the kid?"
<yrlnry> You need to get out more, seriously.
<ne2k__> yrlnry: I meant the original question
<Roderick> Congratulations, I hope it's going well.
<yrlnry> Do you know that Jewish folktale about the man who lives in a
tiny hut with his wife and kids and they can't stand the
crowding any more, so they go to the rabbi for advice, and
the rabbit suggests that they bring the chickens, goat, and
cow into the house too?
<ne2k__> yrlnry: not that it has anything to do with perl, but the
<input> tag in HTML has both "name" and "value" attributes.
the value is what gets shown in the browser typically.
<yrlnry> ne2k__: yes, and the value is also what is submitted when
someone presses the button, but I want the displayed label to
be different from what it submitted, as it is say with
<option ...>
-- yrlnry as a Perl newbie
-- #perl, Freenode