日本語名

部品_転記_列単位

英語名

TransferColumn_WithMap

URL

https://feelcodelab.com/vba_parts/transfercolumn_withmap/

用途

・マッピング表の各行に従い、転記元の「列」を、最終行まで（最終行は可変）、転記先の列へ転記する（列単位・値のみ）
・マッピング表の1行が、転記する1列分になる。複数列は、表に行を足すだけで増やせる
・マッピング表は、範囲設定_行可変 などで作った Range を渡す
  表の中は、どの列に何が入っているかを、引数（列の位置）で指定する（表を自由にデザインできる）
・名前に「転記（Transfer）」が付く部品は、マッピング表を使う
  → Components named "転記 (Transfer)" use a mapping table.
    セル単位は「転記_セル単位」、列単位は「転記_列単位」の、別の部品である
    → Cell-by-cell is "転記_セル単位", column-by-column is "転記_列単位"; they are separate.
※ この部品は Sub（プロシージャ）ではなく「Function（関数）」で、成功／失敗を Boolean で返す

基礎区分

応用

用途区分

処理

操作対象区分

範囲

前提条件

・【最重要】この部品は Function（関数）であり、戻り値（Boolean）を返す
  → 転記できた場合は True、実行時にできなかった場合は False（この場合は、エラーでは止まらない）
  → 呼び出し側は、必ず戻り値を確認してから後続処理を行い、メッセージも呼び出し側で表示する
    （False のときは、MsgBox のあとに Exit Sub まで書く）
・【最重要】転記元のブック（vSrcWb）と、転記先のブック（vDstWb）は、必ず引数で指定する（省略できない）
  → ファイルを開く部品の後は、ActiveWorkbook が開いたファイルに切り替わる。
    開いた直後に、ActiveWorkbook を変数へ控えて、その変数を渡す
・【最重要】マッピング表の範囲（vMapRng）は、見出し行を含めない、データの行だけの範囲を渡す
  → 範囲は、範囲設定_行可変などで作る。最終行は、必ずデータが入っている列で判定する
・【最重要】列の位置（vColSrcSheet ～ vColDstCol）は、マッピング表の範囲の「左端の列」を 1 とした番号で指定する
  → 例：範囲が A 列から始まる場合、B 列は 2。範囲が B 列から始まる場合、B 列は 1
・マッピング表の例（A 列から G 列。範囲は A 列から始まる）
     名称 | 転記元シート名 | 転記元開始行 | 転記元列位置 | 転記先シート名 | 転記先開始行 | 転記先列位置
     内容 | 例1_転記元     | 2            | 2            | 例1_転記先     | 14           | 2
     数量 | 例2_転記元     | 2            | 3            | 例2_転記先     | 14           | 10
     この場合の列の位置は、転記元シート名＝2、転記元開始行＝3、転記元列位置＝4、
     転記先シート名＝5、転記先開始行＝6、転記先列位置＝7 になる
・引数と表の並びは、他の部品と同じく「行 → 列」の順（開始行、列位置の順）にそろえる
・表の「列位置」「開始行」は、1 以上の数字で書く（"B" のようなアルファベットではなく、B 列なら 2）
・転記する範囲は、転記元の「開始行」から、その列の「最終行」まで（最終行は、転記元の、その列で判定する）
    その列に、開始行以降のデータが無い場合は、その行（列）は何もせず、次の行へ進む（エラーではない）
・シート名に "ActiveSheet" と書くと、その時点で、指定したブック（vSrcWb／vDstWb）の、
  アクティブなシートを指す（テンプレートのシートをコピーした直後など、シート名が定まらないときに使う）
  → 転記を始める前に、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_GetLastRow（部品_最終行取得）が必要
    ・転記元の列の、最終行の取得に使用
・f_SetRange_Fixed（部品_範囲設定_固定）が必要
    ・転記元の範囲と、転記先の左上セルの作成に使用
・f_CopyRange_Values（部品_範囲コピー_値）が必要
    ・1列分の値の転記に使用
・組み合わせ：f_SetRange_VariableRows → f_TransferColumn_WithMap
  （範囲設定_行可変で、マッピング表の範囲を作ってから、渡す）
・組み合わせ：f_OpenFile_ByPath → f_TransferColumn_WithMap
  （転記先のファイルを開いてから転記する場合。開いた直後に ActiveWorkbook を変数へ控える）

依存関係（シート）

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

引数

vSrcWb          : 転記元のブック（Workbook）／必須（省略できない）
vDstWb          : 転記先のブック（Workbook）／必須（省略できない）
vMapRng         : マッピング表の範囲（Range）。見出し行を含まない、データの行だけ
vColSrcSheet    : 転記元のシート名が入っている列の位置（Long）。範囲の左端を 1 とした番号
vColSrcStartRow : 転記元の「開始行」が入っている列の位置（Long）
vColSrcCol      : 転記元の「列位置」が入っている列の位置（Long）
vColDstSheet    : 転記先のシート名が入っている列の位置（Long）
vColDstStartRow : 転記先の「開始行」が入っている列の位置（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 vColSrcStartRow As Long, _
        ByVal vColSrcCol As Long, _
        ByVal vColDstSheet As Long, _
        ByVal vColDstStartRow As Long, _
        ByVal vColDstCol As Long) As Boolean

    部品_転記_列単位 = f_TransferColumn_WithMap(vSrcWb, vDstWb, vMapRng, _
                                              vColSrcSheet, vColSrcStartRow, vColSrcCol, _
                                              vColDstSheet, vColDstStartRow, vColDstCol)

End Function

Function f_TransferColumn_WithMap( _
        ByVal vSrcWb As Workbook, _
        ByVal vDstWb As Workbook, _
        ByVal vMapRng As Range, _
        ByVal vColSrcSheet As Long, _
        ByVal vColSrcStartRow As Long, _
        ByVal vColSrcCol As Long, _
        ByVal vColDstSheet As Long, _
        ByVal vColDstStartRow 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 srcCol As Long
    Dim srcStartRow As Long
    Dim srcLastRow As Long
    Dim dstCol As Long
    Dim dstStartRow As Long
    Dim dstEndRow As Long
    Dim srcRng As Range
    Dim dstTopLeft As Range

    f_TransferColumn_WithMap = False

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

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

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

    If vColSrcSheet < 1 Or vColSrcSheet > vMapRng.Columns.Count Or _
       vColSrcStartRow < 1 Or vColSrcStartRow > vMapRng.Columns.Count Or _
       vColSrcCol < 1 Or vColSrcCol > vMapRng.Columns.Count Or _
       vColDstSheet < 1 Or vColDstSheet > vMapRng.Columns.Count Or _
       vColDstStartRow < 1 Or vColDstStartRow > vMapRng.Columns.Count Or _
       vColDstCol < 1 Or vColDstCol > vMapRng.Columns.Count Then
        Err.Raise vbObjectError + 1015, "f_TransferColumn_WithMap", _
                  "列の位置は、マッピング表の範囲の列数（" & vMapRng.Columns.Count & "列）の中で、" & _
                  "左端を 1 として指定してください" & _
                  "（転記元シート名=" & vColSrcSheet & "、転記元開始行=" & vColSrcStartRow & "、転記元列位置=" & vColSrcCol & _
                  "、転記先シート名=" & vColDstSheet & "、転記先開始行=" & vColDstStartRow & "、転記先列位置=" & 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_TransferColumn_WithMap", _
                      "マッピング表の" & mapRowNo & "行目：転記元シート「" & srcSheetName & _
                      "」が、ブック「" & vSrcWb.Name & "」に存在しません。"
        End If

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

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

        srcCol = CLng(vMapRng.Cells(i, vColSrcCol).Value)
        srcStartRow = CLng(vMapRng.Cells(i, vColSrcStartRow).Value)
        dstCol = CLng(vMapRng.Cells(i, vColDstCol).Value)
        dstStartRow = CLng(vMapRng.Cells(i, vColDstStartRow).Value)

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

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

        srcLastRow = f_GetLastRow(vSrcWb, srcSheetName, srcCol)
        If srcLastRow >= srcStartRow Then
            dstEndRow = dstStartRow + (srcLastRow - srcStartRow)
            If dstEndRow > vDstWb.Worksheets(dstSheetName).Rows.Count Then
                Err.Raise vbObjectError + 1009, "f_TransferColumn_WithMap", _
                          "マッピング表の" & mapRowNo & "行目：転記先の終了行が、シートの上限（" & _
                          vDstWb.Worksheets(dstSheetName).Rows.Count & "行）を超えます（終了行=" & dstEndRow & "）。"
            End If
        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

        srcCol = CLng(vMapRng.Cells(i, vColSrcCol).Value)
        srcStartRow = CLng(vMapRng.Cells(i, vColSrcStartRow).Value)
        dstCol = CLng(vMapRng.Cells(i, vColDstCol).Value)
        dstStartRow = CLng(vMapRng.Cells(i, vColDstStartRow).Value)

        srcLastRow = f_GetLastRow(vSrcWb, srcSheetName, srcCol)

        If srcLastRow >= srcStartRow Then

            Set srcRng = f_SetRange_Fixed(vSrcWb, srcSheetName, srcStartRow, srcCol, srcLastRow, srcCol)
            Set dstTopLeft = f_SetRange_Fixed(vDstWb, dstSheetName, dstStartRow, dstCol, dstStartRow, dstCol)

            If f_CopyRange_Values(srcRng, dstTopLeft) = False Then
                Debug.Print "f_TransferColumn_WithMap: マッピング表の" & mapRowNo & "行目で、転記に失敗したため、止めました。"
                Exit Function
            End If

        End If

    Next i

    f_TransferColumn_WithMap = True
    Exit Function

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

End Function

呼び出し・活用事例

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

Set map = 部品_範囲設定_行可変(ThisWorkbook, "マッピング表", 2, 1, 7, 2)   '2行目から、A-G列。最終行は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, "マッピング表", 2, 1, 7, 2)
If map Is Nothing Then MsgBox "マッピング表にデータがありません": Exit Sub
If 部品_転記_列単位(ThisWorkbook, wbDst, map, 2, 3, 4, 5, 6, 7) = False Then MsgBox "転記に失敗しました": Exit Sub

◆マッピング表の例◆
名称 | 転記元シート名 | 転記元開始行 | 転記元列位置 | 転記先シート名 | 転記先開始行 | 転記先列位置
内容 | 例1_転記元     | 2            | 2            | 例1_転記先     | 14           | 2
数量 | 例2_転記元     | 2            | 3            | 例2_転記先     | 14           | 10

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

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

TransferColumn_WithMap.bas

バージョン

1.0

更新日

2026-10-29