1 目的 構想中
転記対応表シートにFORM→DB、DB→DB、DB→FORMへのマッピングをFORMならセルアドレス、DBなら列記号の形で書く。
A項目名 B読取元 C転記先 D転記先表示形式 Eコメント
制御パラメタシートにオプションで読取DB開始行、読取DB終了行、転記先DB最終行判定列、などを書く。
A項目 B内容
で、読取元シートから転記先シートへ転記するマクロ。
2コード（構想中）
' '' ================================================================= ' 【汎用転記システム】 v1.1 - 更新日:2025/06/23 ' 機能概要: Excelシート間のデータ転記・変換処理 ' 使用Enum: enum転記処理をまとめて実行するMode ' 依存関係: なし ' 関連関数: 転記処理をまとめて実行する, getパラメタシート値, getLastRow, get項目に応じた特別計算 ' 変更履歴: v1.0→v1.1 関数名統一・get/isプレフィックス適用 ' ================================================================= ' ' 【転記対応表シート構成】 ' A:項目名 B:読取参照 C:転記先参照 D:表示形式 E:個別処理フラグ ' 売上金額 H M #,##0 SKIP_IF_ZERO ' 顧客名 K P (空白) (空白) ' 更新日時 N AA yyyy/mm/dd CUSTOM_CALC ' ' 【転記パラメタシート構成】 ' A列:項目名 | B列:値 ' ───────────────┼─────── ' 読取開始行 | 2 ' 読取終了行 | 100 ' 転記先判定列 | A ' ================================================================= Public Enum enum転記処理をまとめて実行するMode DB_TO_DB = 1 FORM_TO_DB = 2 DB_TO_FORM = 3 End Enum ' メイン転記プロシージャ Public Sub 転記処理をまとめて実行する( _ str転記列対応表シート名 As String, _ str制御パラメタシート名 As String, _ str読取元シート名 As String, _ str転記先シート名 As String, _ enum転記モード As enum転記処理をまとめて実行するMode _ ) Dim ws転記対応表 As Worksheet Dim ws転記パラメタ As Worksheet Dim ws読取元 As Worksheet Dim ws転記先 As Worksheet Set ws転記対応表 = ThisWorkbook.Sheets(str転記列対応表シート名) Set ws転記パラメタ = ThisWorkbook.Sheets(str制御パラメタシート名) Set ws読取元 = ThisWorkbook.Sheets(str読取元シート名) Set ws転記先 = ThisWorkbook.Sheets(str転記先シート名) ' 制御パラメタ取得 Dim RNo読取開始行番号 As Long Dim RNo読取終了行番号 As Long Dim CLet転記先判定列記号 As String Dim RNo転記先行 As Long RNo読取開始行番号 = getパラメタシート値(ws転記パラメタ, "読取開始行", 2) RNo読取終了行番号 = getパラメタシート値(ws転記パラメタ, "読取終了行", RNo読取開始行番号) CLet転記先判定列記号 = getパラメタシート値(ws転記パラメタ, "転記先判定列", "A") ' 転記先の次空き行を取得 RNo転記先行 = getLastRow(ws転記先, CLet転記先判定列記号) + 1 ' 転記実行 Select Case enum転記モード Case DB_TO_DB For RNo読取行 = RNo読取開始行番号 To RNo読取終了行番号 Call 対応表を見ながら1行ずつ転記する( _ ws転記対応表, _ ws読取元, _ ws転記先, _ enum転記モード, _ RNo読取行, _ RNo転記先行 _ ) RNo転記先行 = RNo転記先行 + 1 Next Case FORM_TO_DB, DB_TO_FORM Call 対応表を見ながら1行ずつ転記する( _ ws転記対応表, _ ws読取元, _ ws転記先, _ enum転記モード, _ RNo読取開始行番号, _ RNo転記先行 _ ) End Select End Sub '------------------------ ' 行転記実行 Private Sub 対応表を見ながら1行ずつ転記する( _ ws転記対応表 As Worksheet, _ ws読取元 As Worksheet, _ ws転記先 As Worksheet, _ enum転記モード As enum転記処理をまとめて実行するMode, _ RNo読取行 As Long, _ RNo転記先行 As Long _ ) Dim RNo最終行 As Long Dim strItem項目名 As String Dim strRef読取参照 As String Dim strRef転記先参照 As String Dim strFormat表示形式 As String Dim strFlag個別処理フラグ As String Dim varValue値 As Variant RNo最終行 = getLastRow(ws転記対応表, "A") For i = 2 To RNo最終行 strItem項目名 = ws転記対応表.Cells(i, 1).Value strRef読取参照 = ws転記対応表.Cells(i, 2).Value strRef転記先参照 = ws転記対応表.Cells(i, 3).Value strFormat表示形式 = ws転記対応表.Cells(i, 4).Value strFlag個別処理フラグ = ws転記対応表.Cells(i, 5).Value ' 必須項目チェック（早期スキップ） If strItem項目名 = "" Or _ strRef読取参照 = "" Or _ strRef転記先参照 = "" Then GoTo 次項目 ' データ取得 Select Case enum転記モード Case DB_TO_DB, DB_TO_FORM varValue値 = ws読取元.Range(strRef読取参照 & RNo読取行).Value Case FORM_TO_DB varValue値 = ws読取元.Range(strRef読取参照).Value End Select ' 個別処理 If strFlag個別処理フラグ <> "" Then Select Case strFlag個別処理フラグ Case "SKIP_IF_ZERO" If IsNumeric(varValue値) And CDbl(varValue値) = 0 Then GoTo 次項目 Case "SKIP_IF_EMPTY" If varValue値 = "" Or _ IsNull(varValue値) Then GoTo 次項目 Case "SKIP_IF_ZERO_OR_EMPTY" If (IsNumeric(varValue値) And CDbl(varValue値) = 0) Or _ varValue値 = "" Or _ IsNull(varValue値) Then GoTo 次項目 Case "CUSTOM_CALC" varValue値 = get項目に応じた特別計算(strItem項目名, varValue値) End Select End If ' 値転記 Select Case enum転記モード Case DB_TO_DB, FORM_TO_DB ws転記先.Range(strRef転記先参照 & RNo転記先行).Value = varValue値 Case DB_TO_FORM ws転記先.Range(strRef転記先参照).Value = varValue値 End Select ' 表示形式設定 If strFormat表示形式 <> "" Then Select Case enum転記モード Case DB_TO_DB, FORM_TO_DB ws転記先.Range(strRef転記先参照 & RNo転記先行).NumberFormat = strFormat表示形式 Case DB_TO_FORM ws転記先.Range(strRef転記先参照).NumberFormat = strFormat表示形式 End Select End If 次項目: Next i End Sub '------------------------ ' パラメタ値取得（統合版） Private Function getパラメタシート値( _ ws転記パラメタ As Worksheet, _ strItem項目名 As String, _ Optional varDefault値 As Variant = "" _ ) As Variant Dim RNo最終行 As Long RNo最終行 = getLastRow(ws転記パラメタ, "A") For i = 2 To RNo最終行 If ws転記パラメタ.Cells(i, 1).Value = strItem項目名 Then getパラメタシート値 = ws転記パラメタ.Cells(i, 2).Value Exit Function End If Next getパラメタシート値 = varDefault値 End Function '------------------------ ' 最終行取得（汎用） Public Function getLastRow( _ ws As Worksheet, _ strCol As String _ ) As Long getLastRow = ws.Range(strCol & Rows.Count).End(xlUp).Row End Function '------------------------ ' カスタム計算処理 Private Function get項目に応じた特別計算( _ strItem項目名 As String, _ varValue値 As Variant _ ) As Variant Select Case strItem項目名 Case "売上額" get項目に応じた特別計算 = IIf(IsNumeric(varValue値), "売上：" & Format(varValue値, "#,##0") & "円", varValue値) Case "利益額" get項目に応じた特別計算 = IIf(IsNumeric(varValue値), varValue値 * 2, varValue値) Case "更新日時" get項目に応じた特別計算 = Now() Case "処理日" get項目に応じた特別計算 = Date Case Else get項目に応じた特別計算 = varValue値 End Select End Function
