プロが教えるわが家の防犯対策術!

日計シートには、スタッフ全員の業務記録が有ります。
(担当者の名称は略称で入力されており、tableシートにフルネームと略称が有ります)
日計シートは作業の都度並べ替えがされており、日付、担当、時刻の順番に並んでいます。

上記のような日計データから、担当別の業務月報を作成したいです。
(担当別月報の冒頭にある担当者欄には、フルネームを記載したいです)

日計に書かれている担当者名と月報に記載する担当者名が異なること、
担当者の数が不定期に変わる(月ごとに)為、月報をどう作成したら良いか、
作成した月報は同保存すべきか・・・その辺に悩んでおります。
下記のような雰囲気を考えておりますが、何か良い方法が有ればご教示下さい。
(各シートのイメージ図を補足に付けます)

Dim i as long '繰り返し数
Dim stlest as long  'tableシートのスタッフ列の最下行番号
Dim sname as string '日計を抽出するスタッフ名称(略称)

stalest = Worksheets("table").Range("I15").End(xlUp).Row

for i = 2 to stlast

same = Worksheets("table").cells(i,10).value

(上記snameを使って日計シートを抽出?)
(この辺に担当者名の略称からフルネームを得るための何か?)

(各担当の名称から日計シートを抽出し、その値を月報シートへ?)
(印刷範囲セットとプレビュー)

next i

「日計シートから、担当者別の業務月報を作成」の質問画像

質問者からの補足コメント

  • tableシートのイメージです

    「日計シートから、担当者別の業務月報を作成」の補足画像1
      補足日時:2017/02/25 18:05
  • 日計シートのイメージです

    「日計シートから、担当者別の業務月報を作成」の補足画像2
      補足日時:2017/02/25 18:05
  • うーん・・・

    実際にはもっと項目の多いシートで作業しておりますが簡易モデルで質問しました。

    ①各シートの場所
     
    同じブック内に有ります。シート名は、”日計”、”table”、”担当別月報”です。


    ②日計シートから業務月報への記載事項

    日計シートの全てを月報に反映させる必要は有りません。
    (例ですと、”担当別月報”にある8項目のみ)

    ③業務月報のシート名など

    同ブックにシートを増やしたくない為、追加シートを同ブックに作成せず、職員ごと印刷プレビュー、PDF等で保存と考えておりましたが別ブックも良いかと思います。

    ④日計シートの日付

    日計シートの日付欄は、日付(数字)が入っているだけです。
    年月のデータは、処理年月としてtableシートに記載。
    (tableシートのA2に処理年、A3に処理月の様に)
    毎月、月初めに新しいブックで記録を開始します。

    No.2の回答に寄せられた補足コメントです。 補足日時:2017/02/25 19:44
  • 概ね、そんな感じです。
    ただ、既にシート数の多いブックで作業しているため、同じブックにシートを増やしたくない想いが有ります。その為、毎回(職員ごとに)印刷プレビューをして、それぞれPDFとかで保存(手作業)する方法を考えておりました。技術的に可能なら、別のブックに、当月分の職員別月報Bookを作り、その各シートに職員別シートが並んでもよいかと思います。

    色々考え、自分でも途中までコーディングしてみました。
    こちらは、補足の方にのせておきます。

    No.3の回答に寄せられた補足コメントです。 補足日時:2017/02/25 21:52
  • 変数の宣言をしてあるとして・・・

    Sub 業務月報()

    '繰り返し回数(スタッフ人数分)を確定させるため、tableシートからスタッフ欄の最下行を求める(フルネーム)
    stLast = Worksheets("table").Cells(Worksheets("table").Rows.Count, 9).End(xlUp).Row


    For i = 2 To stLast

    sname = Worksheets("table").Cells(i, 10).Value


    'ワークシート関数を使い、snameかフルネーム(fullname)のある行番号を判定させる
    fullnameG = Worksheets("table").Application.WorksheetFunction.Match(sname, Worksheets("table").Range("J2:J14"))

      補足日時:2017/02/25 21:55
  • 続きまして・・・


    '月報の該当セルにフルネームを記載
    Worksheets("担当別月報").Range("G2").Value = Worksheets("table").Cells(fullnameG, 9).Value


    '検索キーをsnameとして日計シートを抽出、月報に転記処理



    gpLast = Worksheets("担当者別月報").Cells(Worksheets("担当者別月報").Rows.Count, 1).End(xlUp).Row
    Worksheets("担当別月報").PageSetup.PrintArea = Worksheets("担当別月報").Range(Cells(1, 1), Cells(gpLast, 8)).Address


    '印刷プレビュー

    Next i

    End Sub

      補足日時:2017/02/25 21:55
  • ご丁寧に有難うございます。

    別に月報のブックを作成する場合、ブック名は「◯年◯月分業務月報」みたいな感じで、
    シートの名前はスタッフのフルネームで良いかと思います、

    作成したブックの場所は、元のファイル(マクロ実行ファイル)と同じフォルダで結構です。

    雛形のシートとして、業務月報のシートを使えたらと思います。

    No.4の回答に寄せられた補足コメントです。 補足日時:2017/02/26 10:22

A 回答 (5件)

以下のマクロを標準モジュールへ登録してください。


-----------------------------------------------
Option Explicit
Public Sub 月報作成()
Dim bk1 As Workbook
Dim sh0, sh1, sh2 As Worksheet
Dim dicT As Object '氏名連想配列 キー:ニックネーム 値:フルネーム
Dim dicG As Object '月報連想配列 キー:月報のシート名 値:行番号
Dim yyyy, mm As Long '年、月
Dim maxrow0 As Long 'tableシート最大行数(I列)
Dim maxrow1 As Long '日計シート最大行数(A列)
Dim row, row2 As Long
Dim key As String
Dim sheetName As String
Dim newBook As String
Dim newBookpath As String
Dim ans As Long
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set dicG = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh0 = Worksheets("table")
Set sh1 = Worksheets("日計")
Set sh2 = Worksheets("雛形")
yyyy = sh0.Cells(2, "A").Value
mm = sh0.Cells(3, "A").Value
maxrow0 = sh0.Cells(Rows.Count, "I").End(xlUp).row 'table I列 最終行を求める
maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).row '日計 A列 最終行を求める
For row = 2 To maxrow0
key = sh0.Cells(row, "J").Value
If key <> "" Then
If dicT.exists(key) = True Then
MsgBox ("ニックネーム重複エラー:" & key)
Exit Sub
End If
'フルーネーム記憶
dicT(key) = sh0.Cells(row, "I").Value
End If
Next
'ニックネームの未登録チェック
For row = 2 To maxrow1
key = sh1.Cells(row, "J").Value
If dicT.exists(key) = False Then
MsgBox (key & "はtableに登録されていません")
Exit Sub
End If
Next
'新規ブックの存在チェック
newBookpath = ThisWorkbook.Path & "\" & yyyy & "年" & mm & "月分業務月報.xlsx"
If Dir(newBookpath) <> "" Then
ans = MsgBox(newBookpath & "が既に存在します。このファイルは上書きされます。続行しますか。", vbOKCancel)
If ans <> vbOK Then Exit Sub
Kill newBookpath
End If
'新規ブック作成
Workbooks.Add
'追加したブックの名前を取得
newBook = ActiveWorkbook.Name
'月報作成
Application.ScreenUpdating = False
For row = 2 To maxrow1
'ニックネーム取得
key = sh1.Cells(row, "J").Value
sheetName = dicT(key)
'最初のシートならシートを新規作成する
If dicG.exists(sheetName) = False Then
dicG(sheetName) = 5
sh2.Copy after:=Workbooks(newBook).Worksheets(Worksheets.Count)
Workbooks(newBook).Worksheets(Worksheets.Count).Name = sheetName
With Workbooks(newBook).Worksheets(sheetName)
.Cells(2, "A").Value = yyyy
.Cells(2, "C").Value = mm
.Cells(2, "G").Value = dicT(key)
End With
End If
row2 = dicG(sheetName)
With Workbooks(newBook).Worksheets(sheetName)
.Cells(row2, "A").Value = sh1.Cells(row, "A").Value '日付
.Cells(row2, "B").Value = sh1.Cells(row, "B").Value '時刻
.Cells(row2, "C").Value = sh1.Cells(row, "D").Value 'ID
.Cells(row2, "D").Value = sh1.Cells(row, "E").Value '顧客名
.Cells(row2, "E").Value = sh1.Cells(row, "F").Value 'メニュー
.Cells(row2, "F").Value = sh1.Cells(row, "H").Value '参考値A
.Cells(row2, "G").Value = sh1.Cells(row, "I").Value '参考値B
.Cells(row2, "H").Value = sh1.Cells(row, "K").Value '備考
End With
dicG(sheetName) = dicG(sheetName) + 1 '行番号加算
Next
'sheet1,2,3を削除
With Workbooks(newBook)
Application.DisplayAlerts = False 'シート削除時の警告を出さないようにする
.Worksheets("Sheet1").Delete
.Worksheets("Sheet2").Delete
.Worksheets("Sheet3").Delete
Application.DisplayAlerts = True 'シート削除時の警告を出すようにする(元に戻す)
End With
Application.ScreenUpdating = True
'新規ブックの保存
Set bk1 = Workbooks(newBook)
bk1.SaveAs Filename:=newBookpath
bk1.Close
MsgBox ("処理完了")
End Sub
----------------------------------------------
不明点は補足してください。
    • good
    • 0
この回答へのお礼

ありがとうございます。
なんだか、想定していたものより随分と本格的かつ壮大な回答を頂き恐縮です。
実際に使うブックに反映させて動かしてみます。

ただ、今の自分レベルでは、全然理解できない部分も有り恐れおののいております。
(特に連想配列とかすごいですね!エクセルでこんなことも出来るんだ!って感じです)
今後の改変やシステム変更にも対応できるよう、これを機にググりながら勉強したいと思います。

この度は何度も補足にお付き合い頂き、かつ迅速な対応、有難うございました!!!

お礼日時:2017/02/26 17:32

No3です。


>技術的に可能なら、別のブックに、当月分の職員別月報Bookを作り、その各シートに職員別シートが並んでもよいかと思います。
可能ですが、
1)ブック名、シート名はどのようにしますか。ネーミング基準の提示をお願いします。
2)作成したブックを格納するフォルダは、当該マクロの存在するexelファイルと同じフォルダで良いですか。
それとも、別なフォルダが良いですか。
当該マクロの存在するexelファイルには、table,雛形,日計の3シートが存在する必要があります。
この回答への補足あり
    • good
    • 0

No2です。

補足ありがとうございました。
同一ブック内に全シートがあるということですが、
”担当別月報”については、”担当別月報”というシートが1つではなく、
"佐藤太郎月報"のような「フルネーム+”月報”」というシートが担当者の数分、存在するという理解で良いでしょうか。
もし、シートのネーミングが、上記以外を希望されるなら、その旨、補足ください。
(例 太郎月報、佐藤太郎_月報、月報_佐藤太郎 等)(いずれにしろ担当者の数分のシートが必要になります)
以下、その前提で話を進めます。

1)予め、ひな形の月報を作っておき、マクロ実行時、そのひな形のシートをコピーし、新しいシート”佐藤太郎月報”
を作成する。そして、そのシートに、佐藤太郎のデータを書き込んで行く。
従って、マクロ実行時は、以下のことが、必須となる。
①ひな形のシートが存在すること。シート名:"雛形"
当然、ひな形のシートには、日計シートのデータは記入されていない。
②前月作成した”佐藤太郎月報”等の各担当者のシートが存在しないこと。
③従って、予め、基本のブックを作成し、その基本のブックをコピーし、それを各月のブックとして使用することが望ましい。
基本のシートには、
日計シート、tableシート、ひな形シートのみが存在する。

2)年月は、以下のように設定する。
tableシートのA2を担当者別月報のA2へ設定
tableシートのA3を担当者別月報のC2へ設定
(年月と日付に関するチェックはしない。例 2017年2月の日計データに31日の日付があっても正常とする)
3)1回のマクロ実行で、全ての担当者を処理する。
尚、担当者のニックネームはユニークであることが前提。(ニックネームの花子が2人いて鈴木花子と山田花子がいることは想定しない)
当然、フルネームはユニークであることが前提。(フルネームの山田花子が二人いることは想定しない)

上記の前提でよろしいでしょうか。不明点等あれば、補足してください。
この回答への補足あり
    • good
    • 0

幾つか質問があります。


1)業務月報、日計シート、tableシートは同じbook内にあるのですか。
それとも、別々ですか。別々の場合、book名とシート名を具体的に提示してください。
2)日計シートのチェックA(C列)、適用(G列)は、業務月報に反映しなくて良いのですか。
3)業務月報のシート名はどのように考えていますか。
1担当者で1bookなら、シート名は年月(例 2017年01月等)の情報のみで良いが、
1bookに全担当者を入れるならシート名は担当と年月の情報が必要(例 佐藤太郎_2017年01月 等)
4)日計シートの日付は、例をみると3、4等の数字になっています。
これは、その数値が入っているだけですか。・・・・①
それとも実際は、日付(2017/2/3)が入っていて、表示上、3を表示していますか。・・・②
もし、①のケースなら、マクロ実行時に何年何月のデータなのかはどうやって知るのでしょうか?
この回答への補足あり
    • good
    • 0

マクロ使用ではなく、一般的なEXCEL関数利用でも十分でしょう。


日報から月報作成ならば、日付から月表示列を設ける(追加)、
名前の略称とフル変換は、そのテーブル参照で可能、
ご参考まで。
    • good
    • 0
この回答へのお礼

有難うございます。
関数の併用も含めて検討致します。

お礼日時:2017/02/25 19:44

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!