Excelでグラフにする
今回すること
３ マクロを実行してデータ操作ができるようにする。
やる気マンマンの方はもう試したかもしれませんが、今回はデータを操作できるようにします。
－－－－－に囲まれたところで解説します。
赤字は解説ポイントです。実際のコードにはありませんし、この部分のコードをコピペすると動かないかも。
前回の 「バランスWiiボードとPCで重心動揺計を作る ４」 をコピペしてください。
コード後方の緑字はそのコードのイミです。
Sub 空白セル()
Worksheets("sheet0").Select
Range("H1").Formula = "=countIf((A1:B7000),""*"")"
If Range("H1") > 0 Then MsgBox "文字型セルがありました。" & vbCrLf & "処理を中止します。", vbOKOnly, "文字型セル"
Worksheets("sheet0").Range("A1:B7000").Select
Dim Rng As Range
Set Rng = Selection
On Error GoTo errhandler
Selection.SpecialCells(xlCellTypeBlanks).Select
MsgBox "空白セルがありました。" & vbCrLf & "処理を中止します。", vbOKOnly, "空白セル"
Set Rng = Nothing
Exit Sub
errhandler:
MsgBox "文字型セル、空白セルはありませんでした。処理を続けます。", vbOKOnly, "セル内容"
If vbOK Then Call 作業シート
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub空白セル（）について（ココはコメントなし）
sheet0のA1からB7000の範囲に文字、空白があればグラフ化できないので、
調べて大丈夫なら次のマクロを続行します。
sheet0のH1セルに計算結果を出力しますので、そのセルに入力してあったものは置換されます。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 作業シート()
'作業用というシートを作る
ActiveWorkbook.Sheets.Add.Name = "作業用"
Range("g1").Value = "重心動揺計測" 'G1セルにタイトルを入力
With Range("G1").Font 'G1セルのフォントについて
.Name = "MS明朝" 'MS明朝体
.Bold = True '太字
.Color = vbBlue '青字
.FontStyle = "斜体" '斜体
.OutlineFont = True 'アウトラインフォント
.Size = 22 '22ポイント
End With
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub作業シート（）について
新しいワークシート「作業シート」を追加してタイトルをつけます。
「重心動揺計測」というタイトルを変更するなら、黒字のコードの
"重心動揺計測"を"変更したもの" に変えればいいです。「"」で挟むのを忘れずに。
同じようにサイズを変えたければ、黒字の「22」を変更します。（ココは「"」はなし）
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Range("A1").Value = "No" 'A1セルに「No」を入力
Range("B1").Value = "X値" 'B1セルに「X値」を入力
Range("C1").Value = "Y値" 'C1セルに「Y値」を入力
Range("D1").Value = "X座標" 'D1セルに「X座標」を入力
Range("E1").Value = "Y座標" 'E1セルに「Y座標」を入力
Columns("G").ColumnWidth = 16 'Gのセルの幅を16
Range("G3:G8").HorizontalAlignment = xlCenter 'G3からG8範囲を中心揃え
Range("G3:P38").RowHeight = 22 'G3からP38範囲の行の高さを22
Range("H:N").ColumnWidth = 8 'HからN範囲の幅を8
Range("G3:G8").Interior.ColorIndex = 34 'G3からG8範囲のセル内を34番の色
Range("I3").Interior.ColorIndex = 34 'I3のセル内を34番の色
Range("K3").Interior.ColorIndex = 34 'K3のセル内を34番の色
Range("M3").Interior.ColorIndex = 34 'M3のセル内を34番の色
Range("K4").Interior.ColorIndex = 34 'K4のセル内を34番の色
Range("H4:J4").Merge 'H5からN5セルを結合
Range("L4:N4").Merge 'H5からN5セルを結合
Range("H5:N5").Merge 'H5からN5セルを結合
Range("H6:N6").Merge 'H6からN6セルを結合
Range("H7:N7").Merge 'H7からN7セルを結合
Range("H8:N8").Merge 'H8からN8セルを結合
Range("G3").Value = "No" 'G3セルに「No」を入力
Range("I3").Value = "年齢" 'I3セルに「年齢」を入力
Range("K3").Value = "性別" 'K3セルに「性別」を入力
Range("M3").Value = "転倒回数" 'M3セルに「転倒回数」を入力
Range("G4").Value = "視覚情報の有無" 'G4セルに「視覚情報の有無」を入力
Range("K4").Value = "計測日" 'K4セルに「計測日」を入力
Range("L4").Value = Format(Date) 'L4セルに今日の日付を入力・・・①
Range("G5").Value = "疾患" 'G5セルに「疾患」を入力
Range("G6").Value = "障害" 'G6セルに「障害」を入力
Range("G7").Value = "肢位" 'G7セルに「肢位」を入力
Range("G8").Value = "備考" 'G8セルに「備考」を入力
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
個人情報を入力する欄の書式です。入力した文字や色を変えるには黒字の部分を変更します。
下から5行目の①Range("L4").Value = Format(Date) はデータ処理の日付を自動入力しています。計測日が処理日でないなら、この1行を消去します。（保存したら以降の処理はすべて日付なしになります。）
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'データを作業用シートにコピーする
Worksheets("Sheet0").Select 'sheet0を選択・・・②
Range("A1:B" & Range("B1").End(xlDown).Row).Copy _
Destination:=Worksheets("作業用").Range("B2") 'A1からB列最終行までコピーし作業用シートのB2に貼り付け
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
②sheet0のデータを壊さない、消去しないように、作業用シートに貼り付けます。
ですから、sheet1にデータがあるからそのまま処理したいという場合には"sheet0"をそのシート名にします。その時は他のsheet0が出てくるところも変更してください。「検索」でsheet0調べてね。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'座標を求める
Worksheets("作業用").Select '作業用シートを選択
Range("D2").Formula = "=B2/40*43" 'D2にB2÷40×43を入力 （※1）
Range("D3").Formula = "=B3/40*43" 'D3にB3÷40×43を入力
Range("D2:D3").AutoFill Destination:=Range("D2:D7000") 'D2、D3のようにD7000まで入力
Range("E2").Formula = "=C2/24*23.2" 'E2にC2÷24×23.2を入力
Range("E3").Formula = "=C3/24*23.2" 'E3にC3÷24×23.2を入力
Range("E2:E3").AutoFill Destination:=Range("E2:E7000") 'E2、E3のようにE7000まで入力
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
データはWiiボードの計測値なのでcm単位に直します。
リハビリテーションツール研究所の掲示板の吉村さんコメントから
とあるので計算式を入れました。出力された数値はセンサから得られた値そのままです。Ｘ軸は－２０～＋２０、Ｙ軸は－１２～＋１２の範囲です。一方、実際のバランスＷｉｉボードのセンサーは横４３㎝、縦２３．２㎝の間隔で設置されています。したがって、出力されたＸ座標を４０で割って４３をかける、Ｙ座標を２４で割って２３．２をかけると㎝に変換できます。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'平均、標準偏差を求める
Range("G12:G16").HorizontalAlignment = xlCenter 'G12からG16範囲を中心揃え
Range("H11").Value = "X（cm）" 'H11セルに「X（cm）」を入力
Range("I11").Value = "Y（cm）" 'I11セルに「Y（cm）」を入力
Range("G12").Value = "平均" 'G12セルに「平均」を入力
Range("H12").Formula = "=AVERAGE(D2:D7000)" 'H12セルにD2からD7000の平均を入力
Range("I12").Formula = "=AVERAGE(E2:E7000)" 'I12セルにE2からE7000の平均を入力
Range("G13").Value = "標準偏差" 'G13セルに「標準偏差」を入力
Range("H13").Formula = "=STDEVP(D2:D7000)" 'H13セルにD2からD7000の標準偏差を入力
Range("I13").Formula = "=STDEVP(E2:E7000)" 'I13セルにE2からE7000の標準偏差を入力
'最大値、最小値を求める
Range("G14").Value = "最大値" 'G14セルに「最大値」を入力
Range("H14").Formula = "=max(D2:D7000)" 'H14セルにD2からD7000の最大値を入力
Range("I14").Formula = "=max(E2:E7000)" 'I14セルにE2からE7000の最大値を入力
Range("G15").Value = "最小値" 'G15セルに「最小値」を入力
Range("H15").Formula = "=min(D2:D7000)" 'H15セルにD2からD7000の最小値を入力
Range("I15").Formula = "=min(E2:E7000)" 'I15セルにE2からE7000の最小値を入力
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
平均は中心、最大値・最小値は矩形の辺になります。
標準偏差はとりあえず作ってみました。（標準偏差が何かをよくわかっていない）
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'矩形面積を求める
Range("G16").Value = "矩形面積（cm2）" 'G16セルに「矩形面積（cm2）」を入力
Range("H16:I16").Merge across:=True 'H16とI16セルを結合
Range("H16").Formula = "=(H14-H15)*(I14-I15)" '矩形の面積をH16セルに入力
'矩形座標
Range("K10").Value = "矩形" 'K10セルに「矩形」を入力
Range("K11").Value = "X（cm）" 'K11セルに「X（cm）」を入力
Range("L11").Value = "Y（cm）" 'L11セルに「Y（cm）」を入力
Range("K12").Value = "=(H14)" 'K12セルにXの最大値を入力
Range("L12").Value = "=(I15)" 'L12セルにYの最小値を入力
Range("K13").Value = "=(H15)" 'K13セルにXの最小値を入力
Range("L13").Value = "=(I15)" 'L13セルにYの最小値を入力
Range("K14").Value = "=(H15)" 'K14セルにXの最小値を入力
Range("L14").Value = "=(I14)" 'L14セルにYの最大値を入力
Range("K15").Value = "=(H14)" 'K15セルにXの最大値を入力
Range("L15").Value = "=(I14)" 'L15セルにYの最大値を入力
Range("K16").Value = "=(H14)" 'K16セルにXの最大値を入力
Range("L16").Value = "=(I15)" 'L16セルにYの最小値を入力
Range("M12").Value = "右下" 'M12セルに「右下」を入力
Range("M13").Value = "左下" 'M13セルに「左下」を入力
Range("M14").Value = "左上" 'M14セルに「左上」を入力
Range("M15").Value = "右上" 'M15セルに「右上」を入力
Range("M16").Value = "右下" 'M16セルに「右下」を入力
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
矩形の座標を求めました。
右下－左下－左上－右下と単純に入力するだけ作業なのに疲れました。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'罫線をひく
Range("G3:N8").Borders.LineStyle = xlContinuous 'G3からN8の範囲に細実線をひく
Range("G3:N8").Borders.ColorIndex = 33 'G3からN8の線の色を33番（青）色にする
Range("G11:I16").Borders.LineStyle = xlContinuous 'G11からI16の範囲に細実線をひく
Range("G11:I16").Borders.ColorIndex = 33 'G11からI16の線の色を33番（青）色にする
Range("G11:I11").Borders(xlEdgeBottom).LineStyle = xlDouble 'G11からI11の下端の横線を二重線にする
Range("K11:L16").Borders.LineStyle = xlContinuous 'K11からL16の範囲に細実線をひく
Range("K11:L16").Borders.ColorIndex = 33 'K11からL16の線の色を33番（青）色にする
Range("K11:L11").Borders(xlEdgeBottom).LineStyle = xlDouble 'K11からL11の下端の横線を二重線にする
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
情報入力の表のところの罫線です。
色とか変えたかったら、黒字のコードを変更してください。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
うー、いっぱいになったから、あとは次回に
0 件のコメント:
コメントを投稿