日本語名

部品_転記_セル単位

英語名

TransferCell_WithMap

URL

https://feelcodelab.com/vba_parts/transfercell_withmap/

用途

・マッピング表の各行に従い、転記元のセルの値を、転記先のセルへ転記する（セル単位・値のみ）
・マッピング表は、範囲設定部品（SetRange_VariableRows など）で作った Range を渡す
  表の中の、どの列に何が書いてあるかは、引数（列の位置）で指定する（表を自由にデザインできる）
・名前に「転記（Transfer）」が付く部品は、マッピング表（転記元・転記先を記入した表）を使う
  → Components named "転記 (Transfer)" use a mapping table (a table listing sources and destinations).
    範囲を直接指定してコピーする部品は「コピー（Copy）」、1つのセルに「＝」で代入する部品は
    「代入（Assign）」で、別の部品である
★ この部品は Sub（プロシージャ）ではなく「Function（関数）」で、成功／失敗を Boolean で返す

基礎区分

応用

用途区分

処理

操作対象区分

セル

前提条件

★【最重要】この部品は Function（関数）であり、戻り値（Boolean）を返す
  → 転記できた場合は True、実行時にできなかった場合は False（この場合は、エラーでは止まらない）
  → 呼び出し側は、必ず戻り値を確認してから後続処理を行い、メッセージも呼び出し側で表示する
    （False のときは、MsgBox のあとに Exit Sub まで書く）
★【最重要】転記元のブック（vSrcWb）と、転記先のブック（vDstWb）は、必ず引数で指定する（省略できない）
  → マッピング表に書いたシート名が「どのブックのシートか」は、この2つの引数で決まる
  → ファイルを開く部品の後は、ActiveWorkbook が、開いたファイルに切り替わる。
    開いた直後に、ActiveWorkbook を変数へ控えて、その変数を渡す
★【最重要】マッピング表の範囲（vMapRng）は、見出し行を含めず、データの行だけの範囲を渡す
  → 範囲は、範囲設定_行可変などで作る。最終行は、必ずデータが入っている列（転記元シートの列など）で判定する
★【最重要】列の位置（vColSrcSheet ～ vColDstCol）は、マッピング表の範囲の「左端の列」を 1 とした番号で指定する
  → 例：範囲が A 列から始まる場合、B 列は 2。範囲が B 列から始まる場合、B 列は 1
・マッピング表の例（A 列から H 列。範囲は A 列から始まる）
     名称   | 転記元シート | 行 | 列 | 転記先シート | 行 | 列 | 備考
     顧客名 | 入力         | 6  | 2  | 帳票         | 3  | 1  |
     この場合の列の位置は、転記元シート＝2、転記元の行＝3、転記元の列＝4、
     転記先シート＝5、転記先の行＝6、転記先の列＝7 になる
・マッピング表の行・列は、1 以上の数字で書く（"B6" のような A1 形式ではない）
・シート名に "ActiveSheet" と書くと、その時点で、指定したブック（vSrcWb／vDstWb）の、
  アクティブなシートを指す（テンプレートのシートをコピーした直後など、シート名が決まらないときに使う）
  → "ActiveSheet" は、実行時の状態に依存するので、シートをコピーした直後など、状態が確実なときだけ使う
  → 転記を始める前に、1 回だけシート名に置き換える（途中でシートが変わっても、同じシートへ転記する）
・転記するのは「値のみ」（書式・数式は転記しない。数式は、結果の値になる）
・転記を始める前に、マッピング表の全行を確認する
  → 1行でも誤りがあれば、1行も転記せずに、行番号を示すエラーで止まる
・転記の途中で、実行時の失敗（保護されたシートなど）が起きた場合、それまでに転記した分は、元に戻らない
  （False を返したあとも、書き込み済みの値は残る）
・設定の誤りは、False ではなく、原因を示すエラーで止まる（Err.Raise）
    - 転記元ブック（vSrcWb）が Nothing（vbObjectError + 1001）
    - 転記先ブック（vDstWb）が Nothing（vbObjectError + 1002）
    - マッピング表の範囲（vMapRng）が Nothing（vbObjectError + 1003）
    - マッピング表のシート名が、指定したブックに存在しない（vbObjectError + 1004：転記元／1005：転記先）
    - マッピング表の行・列が、1 以上の数字でない（vbObjectError + 1007）
    - マッピング表の行・列が、シートの上限を超えている（vbObjectError + 1009）
    - 列の位置の指定が、マッピング表の範囲の列数の外（vbObjectError + 1015）
・Offset / Find / Resize / With は禁止

依存関係（部品）

・f_SheetExists（部品_シート存在チェック）が必要
    ・マッピング表のシート名が、指定したブックに存在するかの確認に使用
・f_AssignCell（部品_代入_セル）が必要
    ・1行ごとの転記（1セルの値の代入）に使用
・組み合わせ：f_SetRange_VariableRows → f_TransferCell_WithMap
  （範囲設定_行可変で、マッピング表の範囲を作ってから、渡す）
・組み合わせ：f_OpenFile_ByPath → f_TransferCell_WithMap
  （転記先のファイルを開いてから転記する場合。開いた直後に ActiveWorkbook を変数へ控える）

依存関係（シート）

・マッピング表（ユーザーが、事前に記入する）
     転記元シート名・転記元の行・転記元の列・転記先シート名・転記先の行・転記先の列
・列の並びは、自由（名称や備考の列があってもよい）。引数の列の位置で、どの列が何かを指定する

引数

vSrcWb        : 転記元のブック（Workbook）※必須（省略できない）
vDstWb        : 転記先のブック（Workbook）※必須（省略できない）
vMapRng       : マッピング表の範囲（Range）。見出し行を含まない、データの行だけ
vColSrcSheet  : 転記元のシート名が入っている列の位置（Long）。範囲の左端を 1 とした番号
vColSrcRow    : 転記元の行が入っている列の位置（Long）
vColSrcCol    : 転記元の列が入っている列の位置（Long）
vColDstSheet  : 転記先のシート名が入っている列の位置（Long）
vColDstRow    : 転記先の行が入っている列の位置（Long）
vColDstCol    : 転記先の列が入っている列の位置（Long）

戻り値

Boolean : 転記できた場合は True、実行時にできなかった場合は False

戻り値の型

Boolean

コード全文

Function 部品_転記_セル単位( _
        ByVal vSrcWb As Workbook, _
        ByVal vDstWb As Workbook, _
        ByVal vMapRng As Range, _
        ByVal vColSrcSheet As Long, _
        ByVal vColSrcRow As Long, _
        ByVal vColSrcCol As Long, _
        ByVal vColDstSheet As Long, _
        ByVal vColDstRow As Long, _
        ByVal vColDstCol As Long) As Boolean

    部品_転記_セル単位 = f_TransferCell_WithMap(vSrcWb, vDstWb, vMapRng, _
                                              vColSrcSheet, vColSrcRow, vColSrcCol, _
                                              vColDstSheet, vColDstRow, vColDstCol)

End Function

Function f_TransferCell_WithMap( _
        ByVal vSrcWb As Workbook, _
        ByVal vDstWb As Workbook, _
        ByVal vMapRng As Range, _
        ByVal vColSrcSheet As Long, _
        ByVal vColSrcRow As Long, _
        ByVal vColSrcCol As Long, _
        ByVal vColDstSheet As Long, _
        ByVal vColDstRow As Long, _
        ByVal vColDstCol As Long) As Boolean

    Const cActiveSheet As String = "ActiveSheet"

    Dim i As Long
    Dim mapRowCount As Long
    Dim mapRowNo As Long
    Dim srcActiveName As String
    Dim dstActiveName As String
    Dim srcSheetName As String
    Dim dstSheetName As String
    Dim srcRow As Long
    Dim srcCol As Long
    Dim dstRow As Long
    Dim dstCol As Long

    f_TransferCell_WithMap = False

    If vSrcWb Is Nothing Then
        Err.Raise vbObjectError + 1001, "f_TransferCell_WithMap", _
                  "転記元のブック（vSrcWb）が設定されていません（Nothing）。"
    End If

    If vDstWb Is Nothing Then
        Err.Raise vbObjectError + 1002, "f_TransferCell_WithMap", _
                  "転記先のブック（vDstWb）が設定されていません（Nothing）。"
    End If

    If vMapRng Is Nothing Then
        Err.Raise vbObjectError + 1003, "f_TransferCell_WithMap", _
                  "マッピング表の範囲（vMapRng）が設定されていません（Nothing）。"
    End If

    If vColSrcSheet < 1 Or vColSrcSheet > vMapRng.Columns.Count Or _
       vColSrcRow < 1 Or vColSrcRow > vMapRng.Columns.Count Or _
       vColSrcCol < 1 Or vColSrcCol > vMapRng.Columns.Count Or _
       vColDstSheet < 1 Or vColDstSheet > vMapRng.Columns.Count Or _
       vColDstRow < 1 Or vColDstRow > vMapRng.Columns.Count Or _
       vColDstCol < 1 Or vColDstCol > vMapRng.Columns.Count Then
        Err.Raise vbObjectError + 1015, "f_TransferCell_WithMap", _
                  "列の位置は、マッピング表の範囲の列数（" & vMapRng.Columns.Count & "列）の中で、" & _
                  "左端を 1 として指定してください" & _
                  "（転記元シート=" & vColSrcSheet & "、転記元の行=" & vColSrcRow & "、転記元の列=" & vColSrcCol & _
                  "、転記先シート=" & vColDstSheet & "、転記先の行=" & vColDstRow & "、転記先の列=" & vColDstCol & "）。"
    End If

    srcActiveName = vSrcWb.ActiveSheet.Name
    dstActiveName = vDstWb.ActiveSheet.Name

    mapRowCount = vMapRng.Rows.Count

    For i = 1 To mapRowCount

        mapRowNo = vMapRng.Row + i - 1

        srcSheetName = CStr(vMapRng.Cells(i, vColSrcSheet).Value)
        dstSheetName = CStr(vMapRng.Cells(i, vColDstSheet).Value)
        If StrComp(srcSheetName, cActiveSheet, vbTextCompare) = 0 Then srcSheetName = srcActiveName
        If StrComp(dstSheetName, cActiveSheet, vbTextCompare) = 0 Then dstSheetName = dstActiveName

        If f_SheetExists(vSrcWb, srcSheetName) = False Then
            Err.Raise vbObjectError + 1004, "f_TransferCell_WithMap", _
                      "マッピング表の" & mapRowNo & "行目：転記元シート「" & srcSheetName & _
                      "」が、ブック「" & vSrcWb.Name & "」に存在しません。"
        End If

        If f_SheetExists(vDstWb, dstSheetName) = False Then
            Err.Raise vbObjectError + 1005, "f_TransferCell_WithMap", _
                      "マッピング表の" & mapRowNo & "行目：転記先シート「" & dstSheetName & _
                      "」が、ブック「" & vDstWb.Name & "」に存在しません。"
        End If

        If IsNumeric(vMapRng.Cells(i, vColSrcRow).Value) = False Or _
           IsNumeric(vMapRng.Cells(i, vColSrcCol).Value) = False Or _
           IsNumeric(vMapRng.Cells(i, vColDstRow).Value) = False Or _
           IsNumeric(vMapRng.Cells(i, vColDstCol).Value) = False Then
            Err.Raise vbObjectError + 1007, "f_TransferCell_WithMap", _
                      "マッピング表の" & mapRowNo & "行目：行・列は、1 以上の数字で書いてください。"
        End If

        srcRow = CLng(vMapRng.Cells(i, vColSrcRow).Value)
        srcCol = CLng(vMapRng.Cells(i, vColSrcCol).Value)
        dstRow = CLng(vMapRng.Cells(i, vColDstRow).Value)
        dstCol = CLng(vMapRng.Cells(i, vColDstCol).Value)

        If srcRow < 1 Or srcCol < 1 Or dstRow < 1 Or dstCol < 1 Then
            Err.Raise vbObjectError + 1007, "f_TransferCell_WithMap", _
                      "マッピング表の" & mapRowNo & "行目：行・列は、1 以上の数字で書いてください" & _
                      "（転記元の行=" & srcRow & "、列=" & srcCol & "、転記先の行=" & dstRow & "、列=" & dstCol & "）。"
        End If

        If srcRow > vSrcWb.Worksheets(srcSheetName).Rows.Count Or srcCol > vSrcWb.Worksheets(srcSheetName).Columns.Count Or _
           dstRow > vDstWb.Worksheets(dstSheetName).Rows.Count Or dstCol > vDstWb.Worksheets(dstSheetName).Columns.Count Then
            Err.Raise vbObjectError + 1009, "f_TransferCell_WithMap", _
                      "マッピング表の" & mapRowNo & "行目：行・列が、シートの上限を超えています" & _
                      "（転記元の行=" & srcRow & "、列=" & srcCol & "、転記先の行=" & dstRow & "、列=" & dstCol & "）。"
        End If

    Next i

    On Error GoTo ErrHandler

    For i = 1 To mapRowCount

        mapRowNo = vMapRng.Row + i - 1

        srcSheetName = CStr(vMapRng.Cells(i, vColSrcSheet).Value)
        dstSheetName = CStr(vMapRng.Cells(i, vColDstSheet).Value)
        If StrComp(srcSheetName, cActiveSheet, vbTextCompare) = 0 Then srcSheetName = srcActiveName
        If StrComp(dstSheetName, cActiveSheet, vbTextCompare) = 0 Then dstSheetName = dstActiveName

        srcRow = CLng(vMapRng.Cells(i, vColSrcRow).Value)
        srcCol = CLng(vMapRng.Cells(i, vColSrcCol).Value)
        dstRow = CLng(vMapRng.Cells(i, vColDstRow).Value)
        dstCol = CLng(vMapRng.Cells(i, vColDstCol).Value)

        If f_AssignCell(vSrcWb, srcSheetName, srcRow, srcCol, _
                        vDstWb, dstSheetName, dstRow, dstCol) = False Then
            Debug.Print "f_TransferCell_WithMap: マッピング表の" & mapRowNo & "行目で、転記に失敗したため、止めました。"
            Exit Function
        End If

    Next i

    f_TransferCell_WithMap = True
    Exit Function

ErrHandler:
    Debug.Print "f_TransferCell_WithMap: " & Err.Number & " " & Err.Description & "（発生元：" & Err.Source & "）"
    f_TransferCell_WithMap = False

End Function

呼び出し・活用事例

＜例1：同じブック内で転記する＞
Dim map As Range

Set map = 部品_範囲設定_行可変(ThisWorkbook, "マッピング表", 3, 1, 8, 2)   '3行目から、A-H列。最終行は2列目（転記元シート）で判定
If map Is Nothing Then
    MsgBox "マッピング表にデータがありません"
    Exit Sub
End If

If 部品_転記_セル単位(ThisWorkbook, ThisWorkbook, map, 2, 3, 4, 5, 6, 7) = False Then
    MsgBox "転記に失敗しました（シートの保護などを確認してください）"
    Exit Sub
End If

＜例2：開いたファイルへ転記する＞
Dim wbDst As Workbook

If 部品_ファイルを開く("E:\TEST\テンプレート.xlsx") = False Then Exit Sub
Set wbDst = ActiveWorkbook                               '開いた直後に控える

Set map = 部品_範囲設定_行可変(ThisWorkbook, "マッピング表", 3, 1, 8, 2)
If map Is Nothing Then MsgBox "マッピング表にデータがありません": Exit Sub
If 部品_転記_セル単位(ThisWorkbook, wbDst, map, 2, 3, 4, 5, 6, 7) = False Then MsgBox "転記に失敗しました": Exit Sub

＜例3：コピーした直後のシートへ転記する（シート名を "ActiveSheet" と書く）＞
wbDst.Worksheets("雛形").Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)   'コピーしたシートが、アクティブになる
If 部品_転記_セル単位(ThisWorkbook, wbDst, map, 2, 3, 4, 5, 6, 7) = False Then MsgBox "転記に失敗しました": Exit Sub
（マッピング表の、転記先シートの列に、ActiveSheet と書いておく）

＜マッピング表の例＞
名称     | 転記元シート | 行 | 列 | 転記先シート | 行 | 列 | 備考
顧客名   | 入力         | 6  | 2  | 帳票         | 3  | 1  |
日付     | 入力         | 4  | 2  | ActiveSheet  | 1  | 3  |

※ 設定の誤り（Nothing、シート名の誤り、行・列の誤り、列の位置の誤り）の場合は、False ではなく、
   原因を示すエラーで止まる（起点の On Error で受けて、Err.Description を表示する）

BASファイル（ダウンロード）

TransferCell_WithMap.bas

バージョン

1.0

更新日

2026-10-29