ヒストグラム、Q-Qプロットの作成

Visual Basic for Applications

Sub Macro()
  Dim Sheet As Integer
  Dim srrr As Integer '起点セルの行番号 Starting
  Dim sccc As Integer '起点セルの列番号 Starting
  Dim occc As Integer '出力列の列番号 Objective
  Dim EndRow As Integer
  Dim step As Single
  Dim UpperLimit As Single
  Dim LowerLimit As Single
  Dim cnt As Integer
  Dim tmp01 As Variant
  Dim tmp02 As Variant
  Dim DataSet As Range
  Dim TotalNumber As Integer
  Dim SearchCondition(100) '固定長配列の場合。インデックス番号は目的に合わせる。
  Dim Frequency(100) '固定長配列の場合。インデックス番号は目的に合わせる。
  Dim rrr As Integer
  Dim Avg As Single
  Dim Std As Single
  Dim Ranking As Integer
  Dim Probability As Single
  Dim NormalProbability As Single
  Dim MSG As String
  Sheet = 1
  srrr = 2
  sccc = 6
  occc = 9
  With Worksheets(Sheet) '複数列(事前消去対象列)の選択
    .Range(.Columns(occc), .Columns(occc + 3)).Select
  End With
  Selection.ClearContents
  Columns(sccc + 1).Select
  Selection.ClearContents
  EndRow = Worksheets(Sheet).Cells(srrr, sccc).End(xlDown).Row
  MSG = "Step"
  step = InputBox(MSG)
  MSG = "UpperLimit"
  UpperLimit = InputBox(MSG)
  MSG = "LowerLimit"
  LowerLimit = InputBox(MSG)
  cnt = 0
  tmp01 = 0
  Set DataSet = Range(Cells(srrr, sccc), Cells(EndRow, sccc))
  TotalNumber = Application.WorksheetFunction.Count(DataSet)
  Do Until UpperLimit <= LowerLimit + step * cnt
    SearchCondition(cnt) = "<" & Round(LowerLimit + step * cnt, 5)
    tmp02 = Application.WorksheetFunction.CountIfs(DataSet, SearchCondition(cnt))
    Frequency(cnt) = tmp02 - tmp01
    tmp01 = tmp02
    cnt = cnt + 1
  Loop
  SearchCondition(cnt) = ">=" & LowerLimit + step * (cnt - 1)
  tmp02 = Application.WorksheetFunction.CountIfs(DataSet, SearchCondition(cnt))
  Frequency(cnt) = tmp02
  For rrr = 0 To cnt
    Worksheets(Sheet).Cells(srrr + rrr, occc) = rrr + 1
    If rrr = 0 Then
      Worksheets(Sheet).Cells(srrr + rrr, occc + 1) = "x" & SearchCondition(rrr)
    ElseIf rrr = cnt Then
      Worksheets(Sheet).Cells(srrr + rrr, occc + 1) = Replace(SearchCondition(rrr), ">=", "") & "≦x"
    Else
      Worksheets(Sheet).Cells(srrr + rrr, occc + 1) = Replace(SearchCondition(rrr - 1), "<", "") & "≦ x" & SearchCondition(rrr)
    End If
    Worksheets(Sheet).Cells(srrr + rrr, occc + 2) = Frequency(rrr)
    Worksheets(Sheet).Cells(srrr + rrr, occc + 3) = Round(Frequency(rrr) / TotalNumber * 100, 1)
  Next rrr
  Worksheets(Sheet).Cells(srrr - 1, occc) = "N"
  Worksheets(Sheet).Cells(srrr - 1, occc + 1) = Worksheets(Sheet).Cells(srrr - 1, sccc) & ":Range"
  Worksheets(Sheet).Cells(srrr - 1, occc + 2) = Worksheets(Sheet).Cells(srrr - 1, sccc) & ":Frequency"
  Worksheets(Sheet).Cells(srrr - 1, occc + 3) = Worksheets(Sheet).Cells(srrr - 1, sccc) & ":Percent(%)"
  'Q-Qプロット(正規確率紙)
  Avg = Application.WorksheetFunction.average(DataSet)
  Std = Application.WorksheetFunction.StDevP(DataSet)
  For rrr = srrr To EndRow
    Ranking = Application.WorksheetFunction.Rank(Worksheets(Sheet).Cells(rrr, sccc), DataSet, 1)
    Probability = (Ranking - 0.5) / TotalNumber
    NormalProbability = Application.WorksheetFunction.NormInv(Probability, Avg, Std)
    Worksheets(Sheet).Cells(rrr, sccc + 1) = NormalProbability
  Next rrr
  Worksheets(Sheet).Cells(srrr - 1, sccc + 1) = Worksheets(Sheet).Cells(srrr - 1, sccc) & ":Q-Q Plot:Theoretical Quantiles"
End Sub