【データ選択の改良その１】 -------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------- モジュールの中身： Sub testt() '*********************************' ' 選択したデータのチェック '*********************************' Worksheets("データ").Activate ActiveCell.CurrentRegion.Select 'アクティブセルを含む表を選択 MsgBox "選択範囲：" & Selection.Address & "，アクティブセル：" & ActiveCell.Address '選択範囲の1行したから選択範囲の行数に１行分引いた行数に選択範囲を変更する End Sub Sub PLOTT() '********************* '　　　散布図 '********************* Dim cnt As Integer cnt = Worksheets.Count '現有のsheet数を数える MsgBox "散布図を見てみよう" Worksheets("データ").Activate ActiveCell.CurrentRegion.Name = "使用したデータ" 'アクティブセルを含む表にに名前をつける Range("使用したデータ").Select 'データの選択 '一番右に作業用新しいシートを作成する Worksheets.Add After:=Worksheets(cnt), Count:=1 ActiveSheet.Name = "使用したデータの表示及び計算結果" Worksheets.Add After:=Worksheets(cnt + 1), Count:=1 ActiveSheet.Name = "相関" Call Rinterface.StartRServer Call Rinterface.PutDataframe("hwdata", Range("使用したデータ"), WithRowNames:=False, RespectHidden:=False) '選択したデータをデータフレームとしてRに渡す Call Rinterface.GetDataframe("hwdata", Range("使用したデータの表示及び計算結果!A2").CurrentRegion) 'A2を含んでいる場所にデータの再表示 Call Rinterface.RRun("plot(hwdata$height,hwdata$weight)") Call Rinterface.StopRServer End Sub Sub CORRELATIONN() '********************* '　　　相関 '********************* Dim cnt As Integer cnt = Worksheets.Count '現有のsheet数を数える MsgBox "回帰直線と相関係数を計算してみよう" ActiveCell.CurrentRegion.Name = "使用するデータ" Range("使用するデータ").Select Call Rinterface.StartRServer Range("使用したデータの表示及び計算結果!A1").Value = "使用したデータ" Call Rinterface.PutDataframe("hwdata", Range("使用するデータ"), WithRowNames:=False, RespectHidden:=False) Call Rinterface.GetDataframe("hwdata", Range("使用したデータの表示及び計算結果!A2").CurrentRegion) Call Rinterface.RRun("bodylm<-lm(hwdata$weight ~ hwdata$height)") Call Rinterface.RRun("plot(hwdata$height,hwdata$weight)") Call Rinterface.RRun("abline(bodylm)") Range("相関!A1").Value = "回帰直線を計算した結果：" Call Rinterface.RRun("sbodylm<-summary(bodylm)") Call Rinterface.GetArray("sbodylm", Range("相関!A2")) Call Rinterface.StopRServer End Sub Sub CreateToolbar() On Error Resume Next Dim Tbar As CommandBar Set Tbar = CommandBars.Add With Tbar .Name = "データの分析(改良T)" .Visible = True End With Set NewButn1 = Tbar.Controls.Add(Type:=msoControlButton) With NewButn1 .Caption = " 散 布 図 " .Style = msoButtonCaption .OnAction = "PLOTT" End With Set NewButn2 = Tbar.Controls.Add(Type:=msoControlButton) With NewButn2 .Caption = " 相 関 " .Style = msoButtonCaption .OnAction = "CORRELATIONN" End With End Sub Sub DestroyToolbar() On Error Resume Next CommandBars("データの分析(改良T)").Delete End Sub ------------------------------------------------------------------- ThisWorkbook.clsの中身： Private Sub workbook_beforeclose(Cancel As Boolean) Call DestroyToolbar End Sub Private Sub workbook_open() Call CreateToolbar End Sub -------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------- 【ユーザーフォーム作成】 -------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------- モジュールの中身： Sub CreateUserform() '************************************************* ' 選択フォームを表示し，必要な計算をRにさせる '************************************************* On Error Resume Next 基本統計量選択フォーム.Show If CheckBox1.Value = True Then OnAction = "平均値" End If If CheckBox2.Value = True Then OnAction = "中央値" End If If CheckBox3.Value = True Then OnAction = "最小値最大値" End If If CheckBox4.Value = True Then OnAction = "分散標準偏差" End If End Sub Sub Makenewsheet() '*********************************** ' 結果表示シートの作成 '*********************************** Dim cnt As Integer cnt = Worksheets.Count '一番右に作業用新しいシートを作成する Worksheets.Add After:=Worksheets(cnt), Count:=1 ActiveSheet.Name = "計算結果" Range("計算結果!A1").Value = "基本統計量" Call Rinterface.StartRServer Call Rinterface.PutDataframe("inputdata", Range(RefEdit1.Value), WithRowNames:=False, RespectHidden:=False) Call Rinterface.RRun("nrowname<-names(inputdata[,-1])") Call Rinterface.GetArray("vinputdataMean", Range("計算結果!B1")) Call Rinterface.StopRServer End Sub Sub 平均値() Call Rinterface.StartRServer Call Rinterface.PutDataframe("inputdata", Range(RefEdit1.Value), WithRowNames:=False, RespectHidden:=False) Call Rinterface.RRun("inputdataMean<-apply(inputdata[,-1],2,mean)") Call Rinterface.RRun("vinputdataMean<-as.vector(inputdataMean)") Range("計算結果!A2").Value = "平均値：" Call Rinterface.GetArray("vinputdataMean", Range("計算結果!B2")) Call Rinterface.StopRServer End Sub Sub 中央値() Call Rinterface.StartRServer Call Rinterface.PutDataframe("inputdata", Range(RefEdit1.Value), WithRowNames:=False, RespectHidden:=False) Call Rinterface.RRun("inputdataMedian<-apply(inputdata[,-1],2,median)") Call Rinterface.RRun("vinputdataMedian<-as.vector(inputdataMedian)") Range("計算結果!A3").Value = "中央値：" Call Rinterface.GetArray("vinputdataMedian", Range("計算結果!B3")) Call Rinterface.StopRServer End Sub Sub 最小値最大値() Call Rinterface.StartRServer Call Rinterface.PutDataframe("inputdata", Range(RefEdit1.Value), WithRowNames:=False, RespectHidden:=False) Call Rinterface.RRun("inputdataMax<-apply(inputdata[,-1],2,max)") Call Rinterface.RRun("vinputdataMax<-as.vector(inputdataMax)") Call Rinterface.RRun("inputdataMin<-apply(inputdata[,-1],2,min)") Call Rinterface.RRun("vinputdataMin<-as.vector(inputdataMin)") Range("計算結果!A4").Value = "最小値：" Call Rinterface.GetArray("vinputdataMax", Range("計算結果!B4")) Range("計算結果!A5").Value = "最大値：" Call Rinterface.GetArray("vinputdataMin", Range("計算結果!B5")) Call Rinterface.StopRServer End Sub Sub 分散標準偏差() Call Rinterface.StartRServer Call Rinterface.PutDataframe("inputdata", Range(RefEdit1.Value), WithRowNames:=False, RespectHidden:=False) Call Rinterface.RRun("inputdataVar<-apply(inputdata[,-1],2,var)") Call Rinterface.RRun("vinputdataVarx<-as.vector(inputdataVar)") Call Rinterface.RRun("inputdataSd<-apply(inputdata[,-1],2,sd)") Call Rinterface.RRun("vinputdataSd<-as.vector(inputdataSd)") Range("計算結果!A6").Value = "分散：" Call Rinterface.GetArray("vinputdataVar", Range("計算結果!B6")) Range("計算結果!A7").Value = "標準偏差：" Call Rinterface.GetArray("vinputdataSd", Range("計算結果!B7")) Call Rinterface.StopRServer End Sub ---------------------------------------------------------------- ユーザーフォームの中身： Private Sub CommandButton1_Click() '************************************* ' 実行ボタン '************************************* If RefEdit1.Value = "" Then '選択した範囲は空白だったら MsgBox "データを選択してください" RefEdit1.SetFocus ' Else OnAction = "OnactionFun" OnAction = "Makenewsheet" End If End Sub Private Sub CommandButton2_Click() '************************************* ' キャンセルボタン '************************************* On Error Resume Next Unload 基本統計量選択フォーム End Sub Private Sub UserForm_Click() End Sub -------------------------------------------------------------------------------------------------------- --------------------------------------------------------------------------------------------------------