[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数Bookから積上げて集計』（s55tac）
複数人のチームで、各担当者が日々行った業務の工数を、
別ファイルで作業項目毎に積み上げて集計したいをしたいのですが、
行き詰ってしまいまして、皆様の知恵をお貸しいただきたく存じます。
よろしくお願いいたします。
【Excel Book1】
⇒終業時に日々更新する各担当者の進捗報告ファイル。
担当者1人に対して1ファイル。
受け持つ作業名毎に、日々作業時間を記入して更新する。
例：山田さんのBook（Book名：進捗管理_山田.xlms）
列A 列B 列C 列D
行1 進捗報告 日付 氏名： 山田
行2 作業名 作業時間 進捗率 完了予定
行3 〇〇作業 2.0h 35％ 10/5
行4 ××作業 3.5h 20％ 11/15
行5 △△作業 3.0h 10％ 12/6
・
・
・
（シート名：山田）
【Excel Book2】
⇒各作業で前日までに、誰が、それぞれどれだけ時間を費やしたか集計するファイル。
シート：担当者に各担当者のBookから作業時間を取り込み、シート：ALLで集計する。
例：工数集計用のBook（Book名：工数集計.xlms）
列A 列B 列C 列D 列E ・・・・・・
行1 作業名 2018/09/01 2018/09/02 2018/09/03 2018/09/03 ・・・・・・
行2 〇〇作業 1.0ｈ 2.0ｈ 1.5ｈ 2.5ｈ ・・・・・・
行3 ××作業 3.0ｈ 1.0ｈ 0.5ｈ 2.5ｈ ・・・・・・
行4 △△作業 2.5ｈ 1.0ｈ ・・・・・・
行5 ◇◇作業 10.0ｈ ・・・・・・
・
・
・
（シート名：山田）
列A 列B 列C
行1 日付
行2 作業名 担当者 作業時間(合計)
行3 〇〇作業 山田 50.0h
行4 ××作業 山田 15.0h
行5 ××作業 高橋 10.0h
行6 △△作業 山田 3.5h
行7 △△作業 鈴木 20.0h
行8 □□作業 高橋 41.5h
行9 ◇◇作業 鈴木 19.8h
行10 ◇◇作業 山田 60.0h
・
・
・
（シート名：ALL）
条件（運用）
・1つの作業名に対して、担当するのは1人とは限らない。
・Excel Book1のB2「作業時間」はその日1日の作業時間、Excel Book2のC2「作業時間(合計)」は、
作業開始時からの合計。
・Excel Book1で終了した作業の行を削除しても、Excel Book2にはそれまでの集計結果が残り続ける。
・Excel Book2は、複数名のExcel Book1を集計するが、作業の表示順は問わない。
・Excel Book1のB1、およびExcel Book2のA1に表示する日付は=TODAY()とする。
・運用として、Excel Book1は終業時にその日の作業時間を更新して上書き保存する。
Excel Book2はファイルを開いた時に、前日までの合計を都度集計する。
以上、恐れ入りますが、どなたかご教授願います。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
誤 Book名：〜.xlms 正 Book名：〜.xlsm
ですよね。（もっとも、そのブックにマクロが書いてなければ、xlsxでもいいわけですが・・・）
さて、
＞行き詰ってしまいまして、皆様の知恵をお貸しいただきたく存じます。
とのことですが、どのようなアプローチをして、どのように行き詰まったのでしょうか？
xlsmっておっしゃってるところをみると、マクロを使うって発想になっているようなので、現状、なんらかのコードは作成されているのではないでしょうか？
そうであれば、当該を提示（もちろん、個人情報などは秘匿してください）頂いたほうが、無駄なキャッチボールが少なくて良いようにおもいます。
（もこな２） 2018/09/21(金) 18:15
（隠居じーさん） 2018/09/23(日) 15:09
誤 Book名：〜.xlms 正 Book名：〜.xlsm
上記、ご指摘の通りです。
現状、Book1からBook2の山田シートに作業名を取り込むところで既に躓いております。
Dim today As Date
Dim SheetName As String
Dim Name As Range
Dim Hour As Single
Workbooks.Open Filename:=ThisWorkbook.Path & "工数集計.xlsm"
ThisWorkbook.Activate
today = Date
Application.ScreenUpdating = False
Set Name = Range("D1")
For isagyou = 3To 50 Step 2
ThisWorkbook.Activate
Hour = Range("B" & isagyou)
SagyouOrder = Range("A" & isagyou)
Else
Workbooks("工数集計.xlsm").Activate
ActiveWorkbook.Worksheets("山田").Select
For isagyou_2 = 2 To 150 Step 2
If Range("A" & isagyou_2).Value = Kubun Then
'何もしない’
Else
Else
End If
Next isagyou_2
If isagyou_2 = 150 Then
For isagyou_3 = 2 To 150 Step 2
If Range("A" & isagyou_3).Value = "" Then
Range("A" & isagyou_3).Value = Kubun
End If
Exit For
End If
Next isagyou_3
End If
End If
Next isagyou
上記にて、エラー等は出ないのですが、Book2に何も反映されません。
恐れいりますが、ご教示いただけませんでしょうか。
よろしくお願いいたします。
（s55tac） 2018/09/27(木) 20:43
（隠居じーさん） 2018/09/27(木) 21:31
二つ以上のBook間で値のやり取りをするのであれば、 ThisWorkbook.Activate とか .Select はやめて
ちゃんと、Book.Sheet.Rangeという風に 記述して F8で一つ一つ実行していくのが一番の近道かと思います。 （SoulMan） 2018/09/27(木) 21:44
Range("A" & isagyou_3).Value
なんて記述は、一つのSheet内かもしくは
Sheetモジュールにでも書くのならありかもしれませんが
Sheetモジュールでも
Me.Range("A" & isagyou_3).Value
^^
なんて書くようにした方が私はいいと思います。
書き手の意志を示すことが大事です。
要は、住所なら県.市.町と書くでしょ？
国からでもいいですけど、、、
でないとF8でデバッグ出来ないでしょ？
ThisWorkbook.Activate なんてのはどうにでもなってしまうので指定したことにはならないのです。 （SoulMan） 2018/09/27(木) 22:00
隠居じーさんが指摘されているように、変数の宣言が強制されてないですね。
なぜ問題かというと、「Kubun」っていう変数を宣言せず、さらには、代入もしていないので、中身が空っぽなわけですが、にもかかわらず、セルの値として、それを書き込むことになっているので、空欄に空欄を書き込んでいるのですから、そりゃ何も起こらないように見えますよ。
さらに、SoulManさんが指摘されているように
Set Name = Range("D1")
Hour = Range("B" & isagyou).Value
SagyouOrder = Range("A" & isagyou).Value
について、マクロが記述しているブックのアクティブシートがの対応するセルなり、セルの値なりがセット（代入）されますが、そのシートってどのシートなんでしょうか？
たとえシートが１つしかないなど、人間様にとっては、あたりまえにシートが特定できる場合でも、Excel君にはThisWorkbook.Worksheets(1) のように伝えてあげないと理解してもらえません。
また、変数についても
宣言している、「today」「Name」「Hour」 はセットや代入をしているものの、どこにも使われてないし、前述のとおり「Kubun」が空っぽのままなのに、セルの値として入れろって命令になってます。
さらに、宣言関係でいえば「isagyou」「isagyou_2」「isagyou_3」もループのカウンタとして使っていますが、宣言が無いですね。
なので、一度落ち着いて、↓あたりを確認して、変数の整理からはじめてみませんか？
http://officetanaka.net/excel/vba/variable/02.htm
（もこな２） 2018/09/27(木) 23:59
(1)フォルダの中から「山田さんのbook」を探す
(2)「山田さんのbook」を開く
(3)「山田さんのbook」の1番目？のシートのB1セルを確認して、いつ（年月日）のデータか確認する。
(4)「工数集計用のBook」の「山田」シートの1行目を調べて(3)で調べた年月日の列を探す。
(5)「山田さんのbook」の1番目？のシートのA3セルから最終行までを順番に以下の処理
(5-a)「工数集計用のBook」の「山田」シートのA列から作業名が合致する行を探す
(5-b) (5)の対象行のB列の値を、「工数集計用のBook」の「山田」シートの、
(5-a)で調べた行＆(4)で調べた列に該当するセルに書き込む。
（6）「山田さんのbook」を保存せず閉じる
っていうのを、山田さん、鈴木さん、田中さん・・・みたいに変えて繰り返すことになりますよね。
そして、「工数集計用のBook」の個人シート？のA列について、作業名を自動的に追加するようにしたいとかだと、難易度がぐ〜〜んとアップしそうな気がします。
このことについて、隠居じーさんさんがおっしゃるようにDictionaryObject使えばいいのかもですが、提示されたコードを拝見する限り、すぐには理解できないレベルなのではないかと・・・・（失礼な言い方ですみません。
もし、設計変更できる段階なら、
_____A_________B_______C____D___ 2018/09/01 〇〇作業 山田 1.0 2018/09/01 ××作業 山田 2.0 2018/09/02 ××作業 田中 2.0 2018/09/02 △△作業 田中 2.0 2018/09/02 △△作業 佐藤 2.0 2018/09/03 ××作業 山田 1.0 2018/09/04 〇〇作業 山田 0.5
のように、工数集計用のBookの集約シートにどんどん累積されるようにした上で、累積結果をSUMIFS関数やピボットテーブル使って集計するようにしたほうが、ゴールが近そうに思います。
（もこな２） 2018/09/28(金) 00:48
おはようございます。 ＾＾
まず情報の転記練習から始められてはと思い。作りました。
シート間で読込み、書込みです。
後で応用出来るかもしれません。 ＾＾；
新規ＢＯＯＫにてお試しください。
Worksheets("山田Ａ") レイアウト
A
1 作業名
Worksheets("山田") レイアウト
A B C D
1 進捗報告 2018/9/22 氏名： 山田
2 作業名 作業時間 進捗率 完了予定
3 掘削 3.2 0.37 2018/11/10
4 調理 1.8 0.18 2019/3/23
5 切削 1.2 0.74 2019/2/6
6 切削 1.1 0.93 2019/3/23
7 舗装 4.2 0.78 2018/12/28
8 撤去 2.4 0.99 2018/11/26
9 舗装 1.3 0.76 2018/11/13
10 組立 2.4 0.15 2018/12/26
11 梱包 1.9 0.48 2019/3/9
12 事務 1.4 0.59 2019/2/21
13 梱包 2.4 0.04 2019/1/1
上記は手入力で入力済みが前程です。
Option Explicit
Sub inport_data()
Dim 書込SH As Worksheet
Dim i As Long, rr As Range, r As Range
Dim mcol As Long, mrow As Long, y As Long
Set 書込SH = Worksheets("山田Ａ")
With Worksheets("山田")
mcol = 書込SH.Cells(1, 書込SH.Columns.Count).End(xlToLeft).Column
Set rr = .Cells(1, 1).CurrentRegion
書込SH.Cells(1, mcol + 1).NumberFormatLocal = "yyyy/mm/dd"
書込SH.Cells(1, mcol + 1) = rr(1, 2)
For y = 3 To rr.Rows.Count
mrow = 書込SH.Cells(書込SH.Rows.Count, 1).End(xlUp).Row
Set r = 書込SH.Range(書込SH.Cells(2, 1), 書込SH.Cells(mrow, 1)).Find(what:=rr(y, 1), _
LookIn:=xlValues, _
lookat:=xlWhole)
If r Is Nothing Then
書込SH.Cells(mrow + 1, 1) = rr(y, 1)
書込SH.Cells(mrow + 1, mcol + 1) = rr(y, 2)
Else
書込SH.Cells(r.Row, mcol + 1) = 書込SH.Cells(r.Row, mcol + 1) + rr(y, 2)
End If
Next
End With
End Sub
Worksheets("山田") レイアウト
の３行目以降（必要実情報に該当部分）をいろいろ変えて様子をみてください。
（隠居じーさん） 2018/09/28(金) 10:28
Dim wb As Workbook, sht As Worksheet, col As Long, rw As Long, fn As String, r As Range, c As Range, cc As Range, tot
For Each sht In ThisWorkbook.Sheets
If Dir(ThisWorkbook.Path & "\進捗管理_" & sht.Name & ".xlsm") <> "" Then
fn = ThisWorkbook.Path & "\進捗管理_" & sht.Name & ".xlsm"
Set wb = Workbooks.Open(Filename:=fn, ReadOnly:=True)
sht.Range("A1").Value = "作業名"
Set r = sht.Rows(1).Find(wb.Sheets(sht.Name).Range("B1").Value, , , xlWhole)
If r Is Nothing Then
col = sht.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column
sht.Cells(1, col) = wb.Sheets(sht.Name).Range("B1").Value
Else
col = r.Column
End If
If WorksheetFunction.CountA(wb.Sheets(sht.Name).Range("B3:B" & Rows.Count)) > 0 Then
For Each c In wb.Sheets(sht.Name).Range("B3:B" & Rows.Count).SpecialCells(2)
If Val(c.Value) > 0 Then
Set r = sht.Range("A:A").Find(c.EntireRow.Cells(1).Value, , , xlWhole)
If r Is Nothing Then
rw = sht.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Else
rw = r.Row
End If
sht.Cells(rw, 1).Value = c.EntireRow.Cells(1).Value
sht.Cells(rw, col).Value = Val(c.Value)
End If
Next c
End If
wb.Close False
Else
If sht.Name <> "ALL" Then MsgBox "同一フォルダに" & "進捗管理_" & sht.Name & ".xlms" & "が存在しませんのでスキップします。", vbCritical
End If
Next sht
Sheets("ALL").Cells.ClearContents
Sheets("ALL").Range("A1").Formula = "=today()"
Sheets("ALL").Range("A2").Resize(, 3).Value = Array("作業名", "担当者", "作業時間(合計)")
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "ALL" Then
If WorksheetFunction.CountA(sht.Range("A2:A" & Rows.Count)) > 0 Then
For Each c In sht.Range("A2:A" & Rows.Count).SpecialCells(2)
tot = 0
If WorksheetFunction.CountA(Range(sht.Cells(c.Row, 2), sht.Cells(c.Row, Columns.Count))) > 0 Then
For Each cc In Range(sht.Cells(c.Row, 2), sht.Cells(c.Row, Columns.Count)).SpecialCells(2)
tot = tot + Val(cc.Value)
Next cc
End If
Sheets("ALL").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = Array(c.Value, sht.Name, tot)
Next c
End If
End If
Next sht
End Sub
（mm） 2018/09/28(金) 10:56
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.