＜（３）の処理用データ(C61:G360)＞
∥表計算シート集３∥xlsokan.html 《戻る》 《玄関へ》
《 相関表作成あれこれ 》
【内容】
相関表作成をいくつかの方法でやってみました。
マクロで実行させれば処理に要する時間は殆ど差がありませんでした。
（いずれもCPU2.3GHz、メモリー512MBで約１秒、CPU166MHz、メモリー48MBで約9秒でした）
なお、小生の『桐』による「教務部補佐」にある相関表作成一括処理は下記の（２）の方法に相当しますが、
一部では『桐』の転置集計を使用するところもあります。
【用例と解説】
（０） サンプルデータはSheet1のセルA60:B360に入れました。
＜サンプルデータと処理用データ(A60:G360)＞
データに対する前処理は相関の頻度のとり方によって異なる部分がありますが、共通する部分もあります。階級幅を２５点にする場合は、
=INT（A61/25)*25 の式をC61に記入しC360までコピーしておきます。
これにより２５点刻みの処理用データが準備できます。B列の素点も同様にD列に処理しておきます。階級幅１０点の場合も同様です。
受け皿としての相関表は以下の(1),(2)の方法ではあらかじめシート内に準備しておきます。
（これもマクロに書き込んでもおいてよい）
（１） 縦軸の各階級毎に度数をとる方法
① 前処理として、データを降順に並べ替えておきます。
② 縦軸の各階級毎にデータを選択する方法をとっているので、
選択条件を記入するセルや、選択先のセルを予め設定します。
＜選択条件を記入するセル(C5:F6)＞ ＜選択したデータの貼り付け先のセル(A370:F670)＞
③ 縦軸となる階級で選択されたデータに対し度数を計算する式を記入したセルを予め用意しておきます。
これによって横軸となる各階級の頻度を計算します。
＜度数を計算する式を記入したセル(J4:AD5)＞
④ 上記③で得た縦軸のある階級の度数分布（この場合はJ6:AD6）の値だけを受け皿である相関表（この場合はJ11:AD21)にコピーします。
縦横の各頻度と累計もマクロ処理しています。相関係数は素点から求めています。
⑤ この方法によるマクロ（A)を下に掲載しています。
（２） データの度数を直接相関表に展開する方法
① 共通の前処理をおこない処理用データを用意します。
（１）の方法は一次元の処理を繰り返すためにデータを降順に
並べ替えますが、ここでの方法は二次元に一挙に展開（入力）するので、
並べ替えの必要がありません。
受け皿の相関表は上記のものをそのまま利用しました。
② 処理用データ（t素点とk素点）を１行毎づつ取得し、縦横の階級を計算し
相関表のどの位置に頻度を入力するかを求めます。
③ Excel VBA には初心者以前に相当する小生ですが、
何とか動きましたので、マクロ（Z)を下に掲載しました。
〔参考〕小生の『桐』による相関表作成一括処理に比べて
処理速度はあまり変わらなかった。
（３） ピボットテーブルを使う方法
① 共通の前処理をおこない処理用データを用意します。
データの並べ替えは必要ありません。受け皿の相関表の準備も不要ですが、
各データに対し件数を表す項目（フィールド）を用意し、
データとして各１を入力しておきます。（上表を参照）
② ピボットテーブル作成ウィザードを利用しました。
この場合、対象データの範囲はC60:G360とし、
レイアウトの画面で、C列(t25幅）を縦軸に、D列(k25幅）を横軸に、
G列（件）をデータ域に設定します。
横軸のデータは降順設定が出来るのですが、縦軸は並べ替えの設定ができませんでした。
③ 作成された表は下のとおりで、縦軸の階級は昇順でした。
＜作成直後のテーブル＞
④ 縦軸の階級を降順表記するため、一旦上記③の表を値だけ（この場合上表のI60:S71）を別のセル（この場合下表のI39）にコピーし、
階級の列から総計の列（この場合下表のI列～S列）について、行は総計の行を除く頻度が表現されている行（この場合下表の41～49）
についてI列（この場合ｔ25幅）で降順の並べ替えをします。
＜縦軸の階級および頻度を降順に並べ替えした表＞
⑤ この後、縦横の累計や相関係数を求めておくと良いが、今回は罫線などの処理設定もしていません。
この方法によるマクロ（X)を下に掲載しています。
〔参考〕『桐』による転置集計による一括処理に比べて処理速度はあまり変わらなかった。
【マクロ(A,Z,X)】
（A) エクセルによる相関表作成（縦軸階級毎に頻度をとる方法、２５点幅）
Sub sokan25()
'-------------------素点の前処理（降順並べ替え・25点幅+10点幅）-------------------------
Range("A60:B360").Select
Selection.Sort Key1:=Range("A61"),
Order1:=xlDescending, Key2:=Range( _
"B61"), Order2:=xlDescending,
Header:=xlGuess, OrderCustom:=1, MatchCase
_
:=False, Orientation:=xlTopToBottom,
SortMethod:=xlPinYin, DataOption1:= _
xlSortNormal, DataOption2:=xlSortNormal
Range("C61").Select
ActiveCell.FormulaR1C1 = "=INT(RC[-2]/25)*25"
Range("D61").Select
ActiveCell.FormulaR1C1 = "=INT(RC[-2]/25)*25"
Range("E61").Select
ActiveCell.FormulaR1C1 = "=INT(RC[-4]/10)*10"
Range("F61").Select
ActiveCell.FormulaR1C1 = "=INT(RC[-4]/10)*10"
Range("C61:F360").Select
Selection.FillDown
Range("J6").Select
ActiveCell.FormulaR1C1 = _
"=IF(DCOUNTA(R370C1:R670C4,4,R[-2]C:R[-1]C)=0,"""",DCOUNTA(R370C1:R670C4,4,R[-2]C:R[-1]C))"
Range("J6:AD6").Select
Selection.FillRight
Range("AJ6").Select
ActiveCell.FormulaR1C1 = _
"=IF(DCOUNTA(R370C1:R670C6,6,R[-2]C:R[-1]C)=0,"""",DCOUNTA(R370C1:R670C6,6,R[-2]C:R[-1]C))"
Range("AJ6:CH6").Select
Selection.FillRight
'-----------------------------頻度処理（25点幅）------------------------------------
Dim I, N
Application.CommandBars("Stop
Recording").Visible = False
Range("C6").Select
For I = 1 To 21
Range("C6").Select
N = 500 - (I - 1) * 25
ActiveCell.FormulaR1C1
= N
Range("A60:D360").AdvancedFilter
Action:=xlFilterCopy, CriteriaRange:=Range
_
("C5:D6"),
CopyToRange:=Range("A370:D670"),
Unique:=False
Range("J6:AD6").Select
Selection.Copy
Range("J10").Select
ActiveCell.Offset(I).Select
Selection.PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode
= False
Next I
'---------------------------頻度・累計計算（25点幅）・相関係数------------------
Range("AE11").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-21]:RC[-1])"
Range("AF11").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+RC[-1]"
Range("AF11").Select
ActiveCell.FormulaR1C1 = "=RC[-1]"
Range("AE11:AE31").Select
Selection.FillDown
Range("AF12").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+RC[-1]"
Range("AF12:AF31").Select
Selection.FillDown
Range("J32").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-21]C:R[-1]C)"
Range("J32:AD32").Select
Selection.FillRight
Range("AD33").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("AC33").Select
ActiveCell.FormulaR1C1 = "=RC[1]+R[-1]C"
Range("J33:AC33").Select
Range("AC33").Activate
Selection.FillLeft
Range("H8").Select
ActiveCell.FormulaR1C1 = "相関係数↓"
ActiveCell.Characters(1, 2).PhoneticCharacters
= "ソウカン"
ActiveCell.Characters(3, 2).PhoneticCharacters
= "ケイスウ"
Range("I9").Select
ActiveCell.FormulaR1C1 = "=CORREL(R60C1:R[351]C1,R60C2:R360C2)"
Range("H8:I9").Select
Selection.Copy
Range("AH8").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'---------------------------------------------------------------------------
Range("C6").Select
End Sub
（Z) エクセルによる相関表作成（直接展開する方法）
Sub sokan-d()
Application.CommandBars("Stop
Recording").Visible = True
'-----------------------------頻度処理（25点幅）------------------------------------
Dim I, T, K,HABA,MANTEN, DOSU,
SHYOT, SHYOK As Integer
Range("J11:AD31").Select
'相関表内の以前のデータを消去する
Selection.ClearContents
Range("A61:B360").Select
'処理対象データの範囲
HABA=25,MANTEN=500 '階級幅と満点の設定
For I = 1 To 301
T = Range("A61:B360").Cells(I,
1).Value '対象範囲の上から下へ順にデータ（ｔ、K)を取り出す
K = Range("A61:B360").Cells(I,
2).Value
If (T = ""
Or K = "") Then Exit For
'T点またはK点のデータがなければ処理を終える
SHYOT = INT(MANTEN/HABA)+1
- INT(T / HABA) 'T点とK点とから相関表に収める階級を求める
SHYOK = INT(K /
HABA) + 1
Range("J11:AD31").Select
'相関表を選ぶ
DOSU = Range("J11:AD31").Cells(SHYOT,
SHYOK).Value '該当度数を入力するセルの現在頻度数を求める
DOSU = DOSU + 1
'現在頻度数に１を加える
Range("J11:AD31").Cells(SHYOT,
SHYOK).Value = DOSU '新しい頻度数で該当セルを更新する
Next I
'---------------------------頻度・累計計算（25点幅）・相関係数------------------
'マクロ(A)と同様なのでここでは省略
'---------------------------計算式を消して値だけ残す（一部の範囲だけの処理段階にある）---
Range("J11:AF33").Select
Selection.Copy
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C6").Select
End Sub
（X) エクセルによる相関表作成（ピヴォットテーブルを使う方法、２５点幅）
Sub PIVOT25()
'-------------------素点の前処理（25点幅、フィールド[件]の設定）-------------------------
Range("C61").Select
ActiveCell.FormulaR1C1 = "=INT(RC[-2]/25)*25"
Range("D61").Select
ActiveCell.FormulaR1C1 = "=INT(RC[-2]/25)*25"
Range("C61:D360").Select
Selection.FillDown
Range("G60").Select
ActiveCell.FormulaR1C1 = "件"
ActiveCell.Characters(1, 1).PhoneticCharacters
= "ケン"
Range("G61").Select
ActiveCell.FormulaR1C1 = "1"
Range("G61:G360").Select
Selection.FillDown
'-------------------ピヴォットテーブルを使う-------------------------
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase,
SourceData:= _
"sample1!R60C3:R360C7").CreatePivotTable
TableDestination:= _
"[dosuu9.xls]sample1!R60C9",
TableName:="ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1", DefaultVersion:=
_
xlPivotTableVersion10
ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").AddFields
RowFields:="t25幅", _
ColumnFields:="k25幅"
ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("件").Orientation
= _
xlDataField
ActiveWorkbook.ShowPivotTableFieldList
= False
Application.CommandBars("PivotTable").Visible
= False
ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotSelect
"t25幅 'Column Grand Total'" _
, xlDataAndLabel, True
Range("I60:S71").Select
Range("S71").Activate
Selection.Copy
Range("I39").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I41:S49").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("I41"),
Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End Sub
'-----------------------------------------------------------以上です------
END
of FILE 《戻る》 《玄関へ》