2012年4月1日日曜日

[EXCEL][マクロ]マッピングによる転記(ソースコード)

Sub onClickExecute()

    ' 現在のシート内にある特定のセルからパス名、ファイル名を取得する
    fromFilePath = Range("C5")
    fromFileName = Range("C6")
    templateFilePath = Range("C7")
    templateFileName = Range("C8")
    mappingFilePath = Range("C9")
    mappingFileName = Range("C10")
    resultFilePath = Range("C11")
    resultFileName = Range("C12")

    ' 転記元ファイルを開く
    Workbooks.Open fromFilePath + "\" + fromFileName

    ' テンプレートファイルを開く
    Workbooks.Open templateFilePath + "\" + templateFileName

    ' マッピングファイルを開く
    Workbooks.Open mappingFilePath + "\" + mappingFileName

    ' マクロ実行結果ファイルは作成する
    Workbooks.Add.SaveAs fileName:=resultFilePath + "\" + resultFileName

    ' マッピングファイルの最初に書かれているシート名を取得する
    loopCtrlSheet = Workbooks(mappingFileName).Sheets("MAPPING").Cells(2, 2)

    ' 全てのデータを転記するまでループ
    For fromLineNum = 2 To 101

        ' 転記元のシートの2列目が空ならばそれ以上のデータがないと判断し、ループを抜ける
        If Workbooks(fromFileName).Sheets(loopCtrlSheet).Cells(fromLineNum, 2) = "" Then Exit For

        ' テンプレートファイルの原紙シートをコピーして転記用の新しいシートを作成する
        Workbooks(templateFileName).Sheets("原紙").Copy Before:=Workbooks(resultFileName).Sheets("Sheet1")

        ' マッピング設定を全て処理するまでループ
        For mappingLineNum = 2 To 101

            ' マッピングファイルの2列目が空ならばそれ以上データがないと判断し、ループを抜ける
            If Workbooks(mappingFileName).Sheets("MAPPING").Cells(mappingLineNum, 2) = "" Then Exit For

            ' 転記元のシートとカラムを取得する
            fromSheet = Workbooks(mappingFileName).Sheets("MAPPING").Cells(mappingLineNum, 2)
            fromColumn = Workbooks(mappingFileName).Sheets("MAPPING").Cells(mappingLineNum, 3)

            ' 転記先のセルを取得する
            toCell = Workbooks(mappingFileName).Sheets("MAPPING").Cells(mappingLineNum, 4)

            ' マッピング設定に従って転記を行う
            Range(toCell) = Workbooks(fromFileName).Sheets(fromSheet).Cells(fromLineNum, fromColumn)

        Next mappingLineNum
    Next fromLineNum

    ' ファイルを閉じる
    Workbooks(fromFileName).Close SaveChanges:=False
    Workbooks(templateFileName).Close SaveChanges:=False
    Workbooks(mappingFileName).Close SaveChanges:=False
    Workbooks(resultFileName).Close SaveChanges:=True

End Sub

0 件のコメント:

コメントを投稿