Option Explicit

Sub AnalyzingResponses()

  Dim NumA As Integer, NumP As Integer, NumL() As Integer
  Dim MaxL As Integer, SumL As Integer, rTab As Integer
  Dim i As Integer, j As Integer, k As Integer, l As Integer
  Dim MaxU As Double, MinU As Double, SumU As Double
  Dim DifU() As Double, cmdstr As String

  Range("B2").CurrentRegion.Name = "TabAL"
  NumA = Range("TabAL").Rows.Count - 1
  NumP = Range(Cells(NumA + 5, 2), _
               Cells(NumA + 4, 2).End(xlDown)).Rows.Count
  Range(Cells(NumA + 4, 2), _
        Cells(NumA + NumP + 4, NumA + 2)).Name = "DataSet"
  
  MaxL = Range("TabAL").Columns.Count - 1
  ReDim NumL(1 To NumA)
  For i = 1 To NumA
    NumL(i) = Application.WorksheetFunction.CountA _
              (Range(Cells(i + 1, 2), Cells(i + 1, MaxL + 1)))
  Next
    
  Rinterface.StartRServer
    
  Rinterface.PutDataframe "mydf", Range("DataSet")
  Rinterface.RRun "xs <- paste('x', 1:(ncol(mydf)-1), sep='')"
  Rinterface.RRun "names(mydf) <- c(xs, 'y')"
  Rinterface.RRun "mydff <- subset(mydf, select = y)"
  For i = 1 To NumA
    cmdstr = "mydff$x" & i & "<- factor(mydf$x" & i & ")"
    Rinterface.RRun cmdstr
  Next
  cmdstr = "options(contrasts = c('contr.sum', 'contr.sum'))"
  Rinterface.RRun cmdstr
  Rinterface.RRun "lmout <- summary(lm(y~., data = mydff))"
    
  rTab = NumA + NumP + 6
    
  Cells(rTab, 3).Value = "係数推定値"
  Cells(rTab, 4).Value = "標準誤差"
  Cells(rTab, 5).Value = "t値"
  Cells(rTab, 6).Value = "p値"
  Cells(rTab, 7).Value = "効用差"
  Cells(rTab, 8).Value = "重要度"
    
  k = 2
  l = 2
  Cells(rTab + 1, 1).Value = "定数"
  Cells(rTab + 1, 3).Name = "Const"
  Rinterface.GetArray "t(lmout$coef[1,])", Range("Const")
  For i = 1 To NumA
    Cells(rTab + k, 1).Value = Cells(i + 1, 1).Value
    k = k + 1
    For j = 1 To NumL(i) - 1
      Cells(rTab + k, 2).Value = Cells(i + 1, j + 1).Value
      cmdstr = "t(lmout$coef[" & l & ",])"
      Cells(rTab + k, 3).Name = "Var"
      Rinterface.GetArray cmdstr, Range("Var")
      k = k + 1
      l = l + 1
    Next
    Cells(rTab + k, 2).Value = Cells(i + 1, NumL(i) + 1).Value
    Range(Cells(rTab + k - NumL(i) + 1, 3), _
          Cells(rTab + k - 1, 3)).Name = "Coef"
    Cells(rTab + k, 3).Value = _
      -1 * Application.WorksheetFunction.Sum(Range("Coef"))
    k = k + 1
  Next
    
  ReDim DifU(1 To NumA)
  SumL = 0
  For i = 1 To NumA
    j = rTab + 1 + i + SumL
    MaxU = WorksheetFunction.Max _
             (Range(Cells(j + 1, 3), Cells(j + NumL(i), 3)))
    MinU = WorksheetFunction.Min _
             (Range(Cells(j + 1, 3), Cells(j + NumL(i), 3)))
    DifU(i) = MaxU - MinU
    Cells(j, 7).Value = DifU(i)
    SumL = SumL + NumL(i)
  Next
    
  SumL = 0
  SumU = WorksheetFunction.Sum(DifU)
  For i = 1 To NumA
    j = rTab + 1 + i + SumL
    Cells(j, 8).Value = DifU(i) / SumU * 100
    SumL = SumL + NumL(i)
  Next

  i = rTab + SumL + NumA
  Cells(i + 3, 1).Value = "決定係数"
  Cells(i + 4, 1).Name = "RS"
  Rinterface.GetArray "lmout$r.squared", Range("RS")
  Cells(i + 3, 2).Value = "自由度調整済み決定係数"
  Cells(i + 4, 2).Name = "ARS"
  Rinterface.GetArray "lmout$adj.r.squared", Range("ARS")

  Rinterface.StopRServer

End Sub