VBAちっぷす 「setter作成」

前提条件
  正規表現を使用するため「Microsoft VBScript Regular Explessions 5.5
」の追加が必要  


```vb

'
' 参照設定
' Microsoft VBScript Regular Explessions 5.5
'

Enum difType
  TYPE_LONG = 0
  TYPE_INTEGER = 1
  TYPE_STRING = 2
  TYPE_LOCAL_DATE = 3
  TYPE_DATE = 4
  TYPE_NONE = 5
  TYPE_NUM = 6
End Enum

'
' パラメタ
'
Const POS_INPUT_OBJECT As String = "B1"
Const POS_DEFAULT_SET As String = "B2"
Const POS_INPUT As String = "B3"
Const POS_OUTPUT As String = "D3"

Dim regExp As New regExp
Dim dateCount As Long
Dim isSetDefaultValue As String


' setterを作成する。
Public Sub createSetter()
    
  ThisWorkbook.Worksheets("Main").Range(POS_OUTPUT).Value = ""
  
  isSetDefaultValue = ThisWorkbook.Worksheets("Main").Range(POS_DEFAULT_SET).Value
    
  Dim source As String
  source = ThisWorkbook.Worksheets("Main").Range(POS_INPUT)
  Dim sources() As String
  sources = Split(source, vbLf)
  
  dateCount = 1
  
  ' 行数分処理
  Dim i
  For i = 0 To UBound(sources)
    Dim difType As difType
    difType = getType(sources(i))
    
    If (difType <> TYPE_NONE) Then
      Dim objectName As String
      Dim fieldName As String
      Dim setter As String
      Dim setterData As String
      Dim isCod As Boolean
      
      ' オブジェクト名取得
      
      objectName = ThisWorkbook.Worksheets("Main").Range(POS_INPUT_OBJECT).Value
      
      ' フィールド名取得
      regExp.Pattern = ".+\s+"
      fieldName = regExp.Replace(sources(i), "")
      regExp.Pattern = ";"
      fieldName = regExp.Replace(fieldName, "")
      fieldName = UCase(Mid(fieldName, 1, 1)) & Mid(fieldName, 2, Len(fieldName))
      
      regExp.Pattern = ".+Cd$"
      isCode = regExp.Test(fieldName)
      
      ' データ取得
      If (isCode = False) Then
        setterData = createData(difType, i + 1)
      Else
        setterData = "★コード値★"
      End If
      
      ' setterを作成し，出力
      setter = objectName & ".set" & fieldName & "(" & setterData & ");"
      ThisWorkbook.Worksheets("Main").Range(POS_OUTPUT).Value = ThisWorkbook.Worksheets("Main").Range(POS_OUTPUT).Value + setter + vbLf
    
    End If
    
    
  Next


End Sub

' 定義型を取得する。
Private Function getType(str As String) As difType
  
  Dim lineDiftype As difType
  lineDiftype = TYPE_NONE
  
  ' Long
  regExp.Pattern = ".+Long\s.+"
  If regExp.Test(str) Then
    lineDiftype = difType.TYPE_LONG
  End If
  
  ' Integer
  regExp.Pattern = ".+Integer\s.+"
  If regExp.Test(str) Then
    lineDiftype = difType.TYPE_INTEGER
  End If
  
  ' String
  regExp.Pattern = ".+String\s.+"
  If regExp.Test(str) Then
    lineDiftype = difType.TYPE_STRING
  End If
  
  ' LocalDate
  regExp.Pattern = ".+LocalDate\s.+"
  If regExp.Test(str) Then
    lineDiftype = difType.TYPE_LOCAL_DATE
  End If

  
  getType = lineDiftype
  
End Function

' setterの引数を作成する。
Private Function createData(lineDiftype As difType, seq) As String

  Dim setData As String
  
  ' デフォルト値あり
  If (isSetDefaultValue = "True") Then
  
    Select Case lineDiftype
      Case difType.TYPE_LONG
        setData = seq & "L"
      Case difType.TYPE_INTEGER
        setData = seq
      Case difType.TYPE_LOCAL_DATE
        setData = "LocalDate.of(2019, 6, " & dateCount & ")"
        dateCount = dateCount + 1
      Case difType.TYPE_STRING
        setData = "文字列" & Format(seq, "0000")
        setData = """" & setData & """"
    End Select
      
  ' デフォルト値なし
  Else
    Select Case lineDiftype
    Case difType.TYPE_LONG
      setData = ""
    Case difType.TYPE_INTEGER
      setData = ""
    Case difType.TYPE_LOCAL_DATE
      setData = "LocalDate.of(9999, 12, 31)"
      dateCount = dateCount + 1
    Case difType.TYPE_STRING
      setData = """"""
    End Select
  
  End If
  
    createData = setData
End Function

```