VBA 同じファイル内のシート間でのファイル操作について

Question

添付のような表があります。
右の表を、左の表の該当する欄にデータを取り込む作業です。
頻度は、月１回です。
バタバタと、他の作業をしながらの作成となるのでなるべく楽に作成したいと思っています。
マクロで、実現は不可能でしょうか？
同じファイル内のシートの別れたデータとなっています。
ご教示願います。

Answer 1

例えば、以下のようなことをする必要があればマクロを使用した方が
楽かと思います。
・工事立入者所属ごとにシートを作成する
・作業内容ごとにシートを作成する

マクロでもできますが、上から順に表示するだけであれば、
他の方の回答のように式をいれるのが一番簡単かと思います。

左のシートを「print」、右のシートを「data」と過程して、標準モジュールに以下のような
マクロを作成しました。
動くことだけしか確認していないので汚いソースですいません…

出力する新規月を「2」で固定していますが、実際は汎用的に処理できるように
したほうがよいと思います。

Option Explicit

'/ Sheet名
Private Const cpSheetPrint As String = "print"
Private Const cpSheetData As String = "data"

'/ 各Sheetの処理開始行
Private Const cpStartRowPrint As Long = 4
Private Const cpStartRowData As Long = 2

'/ ◆列定数（printシート）
Private Const cpColPrt_No As Long = 1
Private Const cpColPrt_Name As Long = 2
Private Const cpColPrt_adress As Long = 3

'/ ◆列定数（dataシート）
Private Const cpColDat_No As Long = 1
Private Const cpColDat_Name As Long = 2
Private Const cpColDat_adress As Long = 3
Private Const cpColDat_Month As Long = 4
Private Const cpColDat_Flg As Long = 5

'/出力する明細の記号
Private Const cpMark As String = "○"

Public Sub Out_Data()

Dim plRowMax             As Long
Dim plDataRow            As Long
Dim plPrintRow           As Long
Dim plDataSheet          As Worksheet
Dim plPrintSheet         As Worksheet

'/ワークシートのセット
Set plDataSheet = ThisWorkbook.Sheets(cpSheetData)
Set plPrintSheet = ThisWorkbook.Sheets(cpSheetPrint)

'/dataシートの最終行セット
plRowMax = plDataSheet.Range("A65536").End(xlUp).Row
plPrintRow = cpStartRowPrint


For plDataRow = cpStartRowData To plRowMax

    '/出力判定
    If plDataSheet.Cells(plDataRow, cpColDat_Month).Value = 2 And _
       plDataSheet.Cells(plDataRow, cpColDat_Flg).Value = cpMark Then

        plPrintSheet.Cells(plPrintRow, cpColPrt_No).Value = plDataSheet.Cells(plDataRow, cpColDat_No).Value
        plPrintSheet.Cells(plPrintRow, cpColPrt_Name).Value = plDataSheet.Cells(plDataRow, cpColDat_Name).Value
        plPrintSheet.Cells(plPrintRow, cpColPrt_adress).Value = plDataSheet.Cells(plDataRow, cpColDat_adress).Value

        plPrintRow = plPrintRow + 1
    
    End If

Next plDataRow

Exit Sub

End Sub

Comments

[cat_junko]

返信ありがとうございます。
月毎かつ○がついている行のみ取り込みたいです。
今は、フィルタをかけて番号を欄外にコピーしてからvlookupで飛ばしています。

[cat_junko]

Option Explicit

'/ Sheet名
Private Const cpSheetPrint As String = "新規入場者名簿"
Private Const cpSheetData As String = "立入"

'/ 各Sheetの処理開始行
Private Const cpStartRowPrint As Long = 7
Private Const cpStartRowData As Long = 3

'/ ◆列定数（新規入場者名簿シート）
Private Const cpColPrt_No As Long = 1
Private Const cpColPrt_会社名 As Long = 2
Private Const cpColPrt_氏名 As Long = 3
Private Const cpColPrt_住所 As Long = 4
Private Const cpColPrt_電話番号 As Long = 5
Private Const cpColPrt_生年月日 As Long = 6
Private Const cpColPrt_免許証 As Long = 7

'/ ◆列定数（立入シート）
Private Const cpColDat_No As Long = 1
Private Const cpColDat_氏名 As Long = 2
Private Const cpColDat_生年月日 As Long = 4
Private Const cpColDat_住所 As Long = 5
Private Const cpColDat_工事立入者所属 As Long = 6
Private Const cpColDat_免許有無 As Long = 9
Private Const cpColDat_新規月 As Long = 10
Private Const cpColDat_対象FLG As Long = 11
Private Const cpColDat_電話番号 As Long = 12

'/出力する明細の記号
Private Const cpMark As String = "○"

Public Sub Out_Data()

Dim plRowMax As Long
Dim plDataRow As Long
Dim plPrintRow As Long
Dim plDataSheet As Worksheet
Dim plPrintSheet As Worksheet

'/ワークシートのセット
Set plDataSheet = ThisWorkbook.Sheets(cpSheetPrint)
Set plPrintSheet = ThisWorkbook.Sheets(cpSheetData)

'/dataシートの最終行セット
plRowMax = plDataSheet.Range("A65536").End(xlUp).Row
plPrintRow = cpStartRowPrint

For plDataRow = cpStartRowData To plRowMax

'/出力判定
If plDataSheet.Cells(plDataRow, cpColDat_新規月).Value = 4 And _
plDataSheet.Cells(plDataRow, cpColDat_対象FLG).Value = cpMark Then

plPrintSheet.Cells(plPrintRow, cpColPrt_No).Value = plDataSheet.Cells(plDataRow, cpColDat_No).Value
plPrintSheet.Cells(plPrintRow, cpColPrt_会社名).Value = plDataSheet.Cells(plDataRow, cpColDat_工事立入者所属).Value
plPrintSheet.Cells(plPrintRow, cpColPrt_氏名).Value = plDataSheet.Cells(plDataRow, cpColDat_氏名).Value
plPrintSheet.Cells(plPrintRow, cpColPrt_住所).Value = plDataSheet.Cells(plDataRow, cpColDat_住所).Value
plPrintSheet.Cells(plPrintRow, cpColPrt_電話番号).Value = plDataSheet.Cells(plDataRow, cpColDat_電話番号).Value
plPrintSheet.Cells(plPrintRow, cpColPrt_生年月日).Value = plDataSheet.Cells(plDataRow, cpColDat_生年月日).Value
plPrintSheet.Cells(plPrintRow, cpColPrt_免許証).Value = plDataSheet.Cells(plDataRow, cpColDat_免許有無).Value

plPrintRow = plPrintRow + 1

End If

Next plDataRow

Exit Sub

End Sub

上記のように現状の表に合わせて作成してみました。
エラーは、出ないのですがうんともすんとも動かないのです。
何か指定を間違えているのでしょうか？

[tomo.ina]

データ用シートと帳票用シートのセットが間違っていると思います。

＜誤＞
'/ワークシートのセット
Set plDataSheet = ThisWorkbook.Sheets(cpSheetPrint)
Set plPrintSheet = ThisWorkbook.Sheets(cpSheetData)

＜正＞
'/ワークシートのセット
Set plDataSheet = ThisWorkbook.Sheets(cpSheetData)
Set plPrintSheet = ThisWorkbook.Sheets(cpSheetPrint)

それでも駄目ならば、意図したように動いているかデバッグしてみては
どうでしょうか？

[cat_junko]

返信＆お礼が遅くなり申し訳ありません。
無事、動くようになりました。
あとは、出力判定を「４」固定ではなく指定するようにできれば完璧なのですが。
宜しくお願いいたします。

[tomo.ina]

新規月の出力判定を動的に変えるにはどこかのセルに入力した値を
マクロ内で取得すればできますよ。

Answer 2

マクロで実現可能かどうかという質問でしら、可能だと思います。

それ以前に、画像データに住所や名前等の個人情報が載ってますが、そちらは
大丈夫でしょうか？

架空の情報でなければ、早急に削除する事をお勧めします。
個人情報漏洩にあたると思います。

ネットにアップする際は住所や名前は黒塗りにするか記号に変換してアップした方がよいと思います。

Comments

[cat_junko]

追記
情報は、架空のものです。
ありがとうございます

[pura90]

架空のデータでしたか、それは良かったです。

さて、肝心のマクロの方ですが、サンプルで書くと下記の様なものでも
良いと思います

データのあるシート名が”A”、データを書き込むシート名を”B”とした場合です。

Sub A()
Dim i As Long
Dim dataRow As Long

Dim flg As String

　Application.ScreenUpdating = False

dataRow = 2 'データのコピー先となる開始行

For i = 2 To 10000 '2はデータのあるシートのチェック開始行、10000はデータの最終行
flg = Sheet("A").Cells(i, 11).Value '11は対象FLGの列数

If flg = "○" Then
'対象フラグが○ならデータをコピー

Sheet("B").Cells(dataRow, 3).Value = Sheet("A").Cells(i, 2).Value
'データのあるシートの氏名をデータを書き込むシートの氏名に書き込む

dataRow = dataRow + 1
End If
Next i

　　Application.ScreenUpdating = True

End Sub

実際に作成する場合は、データの最終行を先に取得して
10000行以上ある場合に対応するのと、ループの終了条件が
他にあれば、追加したりすることで、要件に近づくと思います。

追記
　サンプルではセル毎にデータをコピーしていますが、
　大量データになってくると、パフォーマンスが悪くなるため、
　コピーするデータが多い場合は範囲コピー等を利用して下さい。

[cat_junko]

取り出し対象が、○と「新規月」だったので「新規月」別のシートを別途作成し変更するところ変更してからやってみたのですが動きませんでした。
Sub month()
Dim i As Long
Dim dataRow As Long

Dim flg As String
Dim cpSheetPrint As Worksheet

Application.ScreenUpdating = False

dataRow = 2 'データのコピー先となる開始行

For i = 2 To 10000 '2はデータのあるシートのチェック開始行、10000はデータの最終行
flg = cpSheetPrint = "新規入場者名簿".Cells(i, 11).Value '11は対象FLGの列数

If flg = "○" Then
'対象フラグが○ならデータをコピー

cpsheetprint = "新規入場者名簿".Cells(dataRow, 3).Value = Sheet("5").Cells(i, 2).Value
'データのあるシートの氏名をデータを書き込むシートの氏名に書き込む

dataRow = dataRow + 1
End If
Next i

Application.ScreenUpdating = True

End Sub

flg = cpSheetPrint = "新規入場者名簿".Cells(i, 11).Value '11は対象FLGの列数
　　　↑エディタ上で、マウスを合わせると「cpSheetPrint = "新規入場者名簿"」と、入力を促されるのですがこの部分がエラーします。

[pura90]

詳細はヘルプを読んだ方が良いと思いますが、
"新規入場者名簿"ではアクセスできないと思います。

新規入場者名簿シートにアクセスするのであれば
サンプルで書いたように

　Sheets("新規入場者名簿").cells(i,11).value

という様に記述しないとアクセス出来ません。

Answer 3

単純に、単純に右の氏名の列を上から、左の氏名の列に簡単にコピーしたいということでしょうか？
それとも行も関係したり、順番もでしょうか？
単純に右から左であれば、右側の表が「Sheet2」に書かれていて氏名がB列で、２行目にあれば左側の氏名のところに関数として「=Sheet2!B2」として、あとはそのセルをコピペで下まで張り付ければ終わりです。
右の表から左へのコピペでOKです。
それでなければ、右側の表で対象の列を上から下まで選択して、コピーして、左側の表で「形式を選択して貼り付け」から「値」を選んで張り付ければいいだけです。

マクロを作ってまでの作業ではない気がします。
もっと複雑なことをしたいのであれば、別ですが