鉄筋CADの出力データをExcelのデータベースに変換

CADシステムから出力される Excel ファイル をデータベースに変換するマクロを作成しました。

出力レイアウトは、見やすさ重視

キレイに出力してくれるのですが、データを再利用するには、手間がかかります。

データベースは、データの再利用重視

このデータを再利用しやすいように、下図のように変換するマクロを作成しました。

VBA サンプルプログラム

変換処理は、下記のようにしています。

sample.vb

Private Sub s_発注データ変換()
  Dim wBKName  As String
  Dim w基準Row As Integer
  Dim w基準Col As Integer
  Dim wRow     As Integer
  Dim wCol     As Integer
  Dim wPage    As Integer
  Dim wNo      As Integer
  Dim w行      As Integer
  Dim w工事名  As String
  Dim wRange   As String
  Dim wTest    As String

  Workbooks(gBookName).Worksheets("発注データ").Range("B6:M1005").ClearContents

  wBKName = fnPickFile(sFileName)

  Application.ScreenUpdating = False
  Workbooks.Open FileName:=sFileName

  With Workbooks(wBKName).Worksheets(1)
    w行 = 6
    wPage = 1

    Do

      w基準Row = 1 + (wPage - 1) * 29

      wRow = w基準Row + 4
      wCol = 4
      w工事名 = .Cells(wRow, wCol).Value
      If w工事名 = "" Or wPage > 100 Then Exit Do

      If wPage = 1 Then
        Workbooks(gBookName).Worksheets("発注データ").Cells(3, 3).Value = w工事名
      End If

      For wNo = 1 To 10
        wRow = w基準Row + 8 + (wNo - 1) * 2 + 1
        wCol = 3
        wRange = .Cells(wRow, wCol).Address(False, False)

        '発注データシートに転記
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 2).Value = .Cells(wRow, wCol).Value            '符号
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 3).Value = .Cells(wRow + 1, wCol).Value        '厚さ
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 4).Value = .Cells(wRow, wCol + 3).Value        'キリ径
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 5).Value = .Cells(wRow, wCol + 4).Value        '枚数
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 6).Value = .Cells(wRow + 1, wCol + 4).Value    '寸法
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 7).Value = .Cells(wRow, wCol + 8).Value        '重量
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 8).Value = .Cells(wRow + 1, wCol + 8).Value    '重量
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 9).Value = .Cells(wRow, wCol + 11).Value       '単重
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 10).Value = .Cells(wRow + 1, wCol + 11).Value  '単重
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 11).Value = .Cells(wRow, wCol + 14).Value      'ロス
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 12).Value = .Cells(wRow, wCol + 17).Value      '切断
        Workbooks(gBookName).Worksheets("発注データ").Cells(w行, 13).Value = .Cells(wRow + 1, wCol + 15).Value  '備考

        w行 = w行 + 1
      Next wNo

      wPage = wPage + 1
    Loop
  End With


  Workbooks(wBKName).Close savechanges:=False
  Application.ScreenUpdating = True

  '発注データ表を表示
  Workbooks(gBookName).Worksheets("発注データ").Activate
  Workbooks(gBookName).Worksheets("発注データ").Range("A1").Select
End Sub

Excel マクロメニュー サンプル

上の処理は、Excel マクロメニューを利用しています。

下記のようにメニュー名とマクロ名を登録するとメニューに表示されます。

Excelカレンダーを集計するマクロをメニュー化したサンプルです。
週間スケジュール管理