EXCEL macro code for Percentile Frequency Calculations (Scroll Down for Cband8 and Cband10 macros)
The following is macro code for calculating Percentile Frequencies from Specific Loudness Patterns imported into a Microsoft EXCEL spreadsheet.
Sub Perc_Freq_Row() 'Calculates Percentile Frequencies for Zwicker Specific Loudness Patterns 'INPUT: Expects one Pattern per Row (The User must select the Range containing the Patterns) 'Calculates total area under Pattern and Seven %-ile Frequencies (as line numbers) '(Line numbers refer to the presentation of the Critical Bands) 'For example: ' Head Acoustics uses 10 lines per band for a total of 240 lines per pattern ' B&K uses 8 lines per band for a total of 192 lines per pattern 'OUTPUT: After skipping one column to the right of the Pattern data, 'the macro displays the results in seven (7) columns
Dim Msg Dim Msg2
'Identify the Calculation Range startcol = Selection.Column numcols = Selection.Columns.Count startrow = Selection.Row numrows = Selection.Rows.Count If numcols = 192 Or numcols = 240 Then For rowind = startrow To startrow + numrows – 1
'Determine the Total Area under the Pattern (Npatsum) For colind = startcol To startcol + numcols - 1 Npatsum = Npatsum + ActiveSheet.Cells(rowind, colind).Value Next colind
'Determine the Percentile Frequencies (line numbers) for the Pattern (Row) 'Incrementally add the cells (freqsum) and compare to the Total Pattern Area 'Flags are set after each Percentile Frequency is found 'Output the results in columns to the right of the Calculation Range I = 0 For colind = startcol To startcol + numcols - 1 I = I + 1 freqsum = freqsum + ActiveSheet.Cells(rowind, colind).Value If Flag1 = 0 Then If freqsum >= Npatsum * 0.1 Then Pct10 = I Flag1 = 1 ActiveSheet.Cells(rowind, startcol + numcols + 1).Value = Pct10 End If End If If Flag2 = 0 Then If freqsum >= Npatsum * 0.2 Then Pct20 = I Flag2 = 1 ActiveSheet.Cells(rowind, startcol + numcols + 2).Value = Pct20 End If End If If Flag3 = 0 Then If freqsum >= Npatsum * 0.3 Then Pct30 = I Flag3 = 1 ActiveSheet.Cells(rowind, startcol + numcols + 3).Value = Pct30 End If End If If Flag5 = 0 Then If freqsum >= Npatsum * 0.5 Then Pct50 = I Flag5 = 1 ActiveSheet.Cells(rowind, startcol + numcols + 4).Value = Pct50 End If End If If Flag7 = 0 Then If freqsum >= Npatsum * 0.7 Then Pct70 = I Flag7 = 1 ActiveSheet.Cells(rowind, startcol + numcols + 5).Value = Pct70 End If End If If Flag8 = 0 Then If freqsum >= Npatsum * 0.8 Then Pct80 = I Flag8 = 1 ActiveSheet.Cells(rowind, startcol + numcols + 6).Value = Pct80 End If End If If Flag9 = 0 Then If freqsum >= Npatsum * 0.9 Then Pct90 = I Flag9 = 1 ActiveSheet.Cells(rowind, startcol + numcols + 7).Value = Pct90 End If End If Next colind Next rowind
Msg = "The Selected Range must contain EXACTLY either 192 or 240 columns." Msg = Msg & Chr$(10) & "PLEASE RE-SELECT THE RANGE & TRY AGAIN" MsgBox Msg, vbExclamation, "Range Selection Error"
End If End Sub
Cband8 – an EXCEL macro to convert B&K line numbers to kHz
Sub Cband8() ' 'Written by: Richard J. Fridrich 05AU99 ' ' For %-ile Freq's from B&K Data which uses 8 lines per band for a total of 192 lines per pattern ' Replaces line numbers (integers from 1 to 192) with frequency values (kHz) ' Dim Msg Dim Cb192(192)
Msg = Msg & Chr$(10) & "The macro (Cband8) REPLACES the Percentile Frequency line number integers with frequency values (kHz) " Msg = Msg & Chr$(10) & "for results from Patterns using 8 lines per band (192 lines per Pattern)[B&K]. " Msg = Msg & Chr$(10) & "IT IS RECOMMENDED that this conversion only be done on copies of the %-ile Freq. line number results." Msg = Msg & Chr$(10) & " " Msg = Msg & Chr$(10) & "Do you want to continue?"
Response = MsgBox(Msg, vbYesNo, "Cband8: Conversion of Line Numbers to Frequency Values") If Response = vbYes Then
'Identify the Calculation Range startcol = Selection.Column numcols = Selection.Columns.Count startrow = Selection.Row numrows = Selection.Rows.Count
'Convert Line Number (Interger) to Frequency (kHz) For R = startrow To startrow + numrows - 1 For C = startcol To startcol + numcols - 1 ActiveSheet.Cells(R, C).Value = Cb192(ActiveSheet.Cells(R, C).Value) Next C Next R
End If
End Sub
Cband10 – an EXCEL macro to convert ArtemiS line numbers to Hz
Sub Cband10() ' 'Written by: Richard J. Fridrich 06AU08 ' ' For %-ile Freq's from ArtemiS Data which uses 10 lines per band for a total of 240 lines per pattern ' Replaces line numbers (integers from 1 to 240) with frequency values (kHz) ' Dim Msg Dim Cb240(240)
Msg = Msg & Chr$(10) & "The macro (Cband10) REPLACES the Percentile Frequency line number integers with frequency values (Hz) " Msg = Msg & Chr$(10) & "for results from Patterns using 10 lines per band (240 lines per Pattern)[ArtemiS]. " Msg = Msg & Chr$(10) & "IT IS RECOMMENDED that this conversion only be done on copies of the %-ile Freq. line number results." Msg = Msg & Chr$(10) & " " Msg = Msg & Chr$(10) & "Do you want to continue?"
Response = MsgBox(Msg, vbYesNo, "Cband10: Conversion of Line Numbers to Frequency Values") If Response = vbYes Then
'Identify the Calculation Range startcol = Selection.Column numcols = Selection.Columns.Count startrow = Selection.Row numrows = Selection.Rows.Count
'Convert Line Number (Interger) to Frequency (kHz) For R = startrow To startrow + numrows - 1 For C = startcol To startcol + numcols - 1 ActiveSheet.Cells(R, C).Value = Cb240(ActiveSheet.Cells(R, C).Value) Next C Next R
