Option Explicit

Sub CreatingProfiles()

  Dim NumAttri As Integer, NumProfi As Integer
  Dim MaxLevel As Integer, NumLevel() As Integer
  Dim MyTitle As String, cmdstr As String
  Dim i As Integer, j As Integer

  MyTitle = "プロファイル作成"
    
  NumAttri = Application.InputBox(prompt:="必要な属性数を入力して下さい。", _
             Title:=MyTitle, Type:=1)

  ReDim NumLevel(1 To NumAttri)

  For i = 1 To NumAttri
    NumLevel(i) = Application.InputBox(prompt:="第" & i & _
                  "属性の水準数を入力して下さい。", _
                  Title:=MyTitle, Type:=1)
  Next

  MaxLevel = Application.WorksheetFunction.Large(NumLevel, 1)

  Cells(1, 1).Value = "属性"
  For i = 1 To MaxLevel
    Cells(1, i + 1).Value = "第" & i & "水準"
  Next

  For i = 1 To NumAttri
    Cells(i + 1, 1).Value = Application.InputBox(prompt:= _
                            "第" & i & "属性の名称を入力して下さい。", _
                            Title:=MyTitle, Type:=2)
    For j = 1 To NumLevel(i)
      Cells(i + 1, j + 1).Value = Application.InputBox(prompt:= _
                                  "第" & i & "属性の第" & j & _
                                  "水準を入力して下さい。", _
                                  Title:=MyTitle, Type:=2)
    Next
  Next

  Cells(NumAttri + 3, 1).Name = "Type"
  Cells(NumAttri + 4, 2).Name = "Attribute"
  Cells(NumAttri + 5, 1).Name = "ProfileNo"
  Cells(NumAttri + 5, 2).Name = "Table"

  Rinterface.StartRserver

  Rinterface.RRun "library(DoE.base)"
    
  Rinterface.RRun "nats<-" & NumAttri

  For i = 1 To NumAttri
    cmdstr = "at" & i & "<-" & NumLevel(i)
    Rinterface.RRun (cmdstr)
  Next

  Rinterface.RRun _
    "ats<-paste(paste('at', 1:nats, ',', sep=''), collapse='')"
  Rinterface.RRun _
    "ats<-substring(ats, 1, nchar(ats)-1)"
  Rinterface.RRun _
    "eval(parse(text=paste('OAtab<-oa.design(nlevels=c(', ats, '))')))"

  Rinterface.GetArray "design.info(OAtab)$type", Range("Type")
  Rinterface.GetArray "t(colnames(OAtab))", Range("Attribute")
  Rinterface.GetArray "rownames(OAtab)", Range("ProfileNo")
  Rinterface.GetArray "OAtab", Range("Table")

  NumProfi = Rinterface.GetRExpressionValueToVBA("nrow(OAtab)")

  Rinterface.StopRServer

  For i = 1 To NumProfi
    Cells(NumAttri + 4 + i, NumAttri + 3).Value = i
  Next

  For i = 1 To NumAttri
    Cells(NumAttri + 4, NumAttri + 3 + i).Value = Cells(i + 1, 1).Value
    For j = 1 To NumProfi
      Cells(NumAttri + 4 + j, NumAttri + 3 + i).Value = _
        Cells(1 + i, Cells(NumAttri + 4 + j, 1 + i).Value + 1).Value
    Next
  Next

Endline:

End Sub