Excelでのデータ作成について

2016/01/01

動機とソースコード

RPGは沢山のデータによって成り立っています。そんな沢山のデータをプチコンで入力するのは大変なので、EXCELを用いて、データを作成し、テキストデータに変更するプログラムを書きました。

使用例

実際のコード

Option Explicit
Private Kata() As Integer
Private Const naComment As Integer = 1

Sub ExcelToPetitcom()
  Dim x As Integer
  Dim y As Integer
  Dim FileName As String
  Dim OneRow As String

  FileName = InputFileName()
  Warning (FileName)
  Open FileName For Output As #1

  Print #1, GetTitleComment()
  Print #1, GetLabel()
  Print #1, GetIndex()
  Call SetVariableType
  For y = 5 To GetMaxRows()
    x = 1
    OneRow = "DATA "
    Call CheckEmpty(y, x)
    OneRow = OneRow & ChangeText(y, x)
    For x = 2 To GetMaxColumns()
      Call CheckEmpty(y, x)
      OneRow = OneRow & "," & ChangeText(y, x)
    Next
    Print #1, OneRow
  Next
  Call EndData
End Sub

'空のデータチェック
Private Sub CheckEmpty(y, x)
  If Cells(y, x) = "" Then
    MsgBox "空のデータがあります。" & vbLf & "座標は（" & Str$(x) & "," & Str$(y) & ")"
  End If
End Sub

'終了
Private Sub EndData()
  Print #1, "'終了"
  MsgBox "変換を終了しました。" & vbLf & "テキストエディタなどで、文字コードを シフトJIS から UTF-8 に、" & vbLf  & "改行コードをCRLFからLFに、変更してください。"
  Close #1
  End
End Sub

'ファイル名入力
Private Function InputFileName() As String
  Dim Name As String
  ChDrive "C"
  ChDir "C:\Users\秀人\Documents\プチコン3号_RPG\data"
  Name = Application.GetOpenFilename("テキスト,*.txt", , "変換したデータが入るファイルを選択")
  If Name = "False" Then
    End
  End If
  InputFileName = Name
End Function

'最終確認
Private Sub Warning(Name)
  Dim Result
  Result = MsgBox("ファイル名は" & Name & "です。" & vbLf & "変換を開始しますか？", vbOKCancel, "アイテム変換確認")
  If Result = vbCancel Then
    MsgBox "変換を中止しました。"
    End
  End If
End Sub

'タイトルと最終更新日を所得
Private Function GetTitleComment()
  GetTitleComment = "'" & Cells(1, 1) & "(" & Cells(1, 3) & ")"
End Function

'ラベルを取得する
Private Function GetLabel()
  Dim Text As String
  Text = Mid(Cells(1, 2), 1)
  GetLabel = Text
End Function

'見出しを取得する
Private Function GetIndex()
  Dim x As Integer
  Dim Text As String
  Text = Cells(3, 1)
  For x = 2 To GetMaxColumns()
    Text = Text & "," & Cells(3, x)
  Next
  GetIndex = "'" & Text
End Function

'数値か文字列かのデータを判断し配列に入れる
Private Sub SetVariableType()
  Dim x As Integer
  Dim Text As String
  ReDim Kata(GetMaxColumns())
  For x = 1 To GetMaxColumns()
    Text = Cells(4, x)
    If Text = "s" Then Kata(x) = vbDouble
    If Text = "m" Then Kata(x) = vbString
    If Text = "c" Then Kata(x) = naComment
  Next
End Sub

'列の数を取得する
Private Function GetMaxColumns()
  Dim Value As Integer
  Value = Cells(3, 1).End(xlToRight).Column
  GetMaxColumns = Value
End Function

'行の数を取得する
Private Function GetMaxRows()
  Dim Value As Integer
  Value = Cells(3, 1).End(xlDown).Row
  GetMaxRows = Value
End Function

Private Function ChangeText(y, x)
  Dim Text As Variant
  Dim Result As String
  Text = Cells(y, x)
  If Kata(x) = naComment Then
    Result = "'" & Text
  Else
    Call CheckVarType(y, x)
    If Kata(x) = vbString Then
      Result = """" & Text & """"
    ElseIf Kata(x) = vbDouble Then
      Result = Text
    End If
  End If
  ChangeText = Result
End Function

'型チェック
Private Sub CheckVarType(y, x)
  If VarType(Cells(y, x)) <> Kata(x) Then
    MsgBox "型の違うデータがあります。" & vbLf & "座標は（" & Str$(x) & "," & Str$(y) & ")"
  End If
End Sub

使い方

使い方は簡単。使用例の画像の様に、データを入力し、ALT+F11を押してエディターを開いて、このコードを入れ実行するだけ。

4行目に入る文字は、その列のデータが文字列ならm 数値が入るならsを入れればいい。コードがあまり綺麗じゃないのは気にしても気にしなくても良い。正常に動くはずです。

文字コードの変換と改行コードの変更は別のプログラムで行ってください。私は、サクラエディタのマクロを使用しました。

サクラエディタのマクロ

まず、これを実行すれば、変換ができます。 //サクラエディタのマクロ(2015/10/04) //改行コードをCRLFからLFにして、 //文字コードをShift-JISから、UTF-8にする。 S_ReplaceAll("\r\n", "\n"); // すべて置換 S_SelectAll(0); // すべて選択 S_SJIStoUTF8(0);// SJIS→UTF-8コード変換 S_ReDraw(0); // 再描画 一度上書き保存をしてから、次を実行すると、開き直して確認することができます。 //サクラエディタのマクロ(2015/10/04) //UTF-8で開きなおして確認する S_FileReopenUTF8(0); // UTF-8で開き直す S_GoFileEnd(0); // ファイルの最後に移動 S_ReDraw(0); // 再描画

ホームに戻る