[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『月報のまとめをしたい』(hana)
社内のシステムが使えなくなってしまいました。
直せる人もいないので、新たに外注する予定ですが
暫定的に、最低限の部分だけ何とかマクロで出来ないかと考えています。
月報として個人毎のシートで纏めているデータがあります
150程シートが存在します。
L9に名前が入っています。
45〜53行(最大)にデータがあります。
C D I 45 工事No 現場名 日数 46 11 事務所 16 47 301 ●工事 3 ・ ・ ・ 53
これを、集計用のExcelファイルに以下のように取り込みたいです。
イメージとしては、
・対象月をどこかに入力してマクロボタンを押下。(以下シート名とA1のYYYYMM部分になる)
・シート追加(シート名は"YYYY年MM月個人別")
・月報を選択する。
・月報の一番右のシート以外を全て抽出する。
抽出は以下のようにしたいです。
A B C D E F 1□□□YYYY年MM月 月間就労時間一覧表(個人別) □□□ 2 社員No 氏名 工事No 工事名称 稼働日数 作業時間 3 001 田中 11 事務所 120.00 4 301 ●工事 22.50 5 【個人名】 19 142.50 6 002 佐藤 302 ×工事 150.00 7 【個人名】 20 150.00 . . .
作業時間は稼働日数×7.5です。残業は考慮しなくても良いです。
社員Noは若い順から表示したいです。
社員Noはマクロボタンを設置するシートのB列、名前はC列にデータがあります。
(逆の方がいいでしょうか)
その他必要な情報はありますでしょうか。
大変申し訳ないのですが、どなたかよろしくおねがいします。
この動作が完成したら、次の工程も質問させていただきたいです。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
>直せる人もいないので、新たに外注する予定
>どなたかよろしくおねがいします。
と仰っているので、とりあえず版をタダで作ってほしいということなのでしょうか?
そういう話しであれば興味がないので私は撤退しますが、自分でがんばってみるということなら
(1)シートを追加する (2)追加したシートの名前を変える (3)ダイアログを出して、ユーザーに月報ファイルを選んでもらう (4)↑を開く (5)↑の1番目〜最後−1番目のシートを巡回して
(6)シート名を(1)に書き出して (7)シートの内容を(1)コピペして
(8)(4)で開いたブックを閉じて (9)(6)をキーに社員Noを調べて(1)に書き込んで (10)(9)をキーに並び替えして (11)A列を上から順に見ていき、1行上と同じ値ならA〜B列をクリア
という処理にすれば実現可能だとおもいます。
(もこな2) 2021/01/26(火) 20:53
自身で頑張りますので、お力添えをしていただけますと幸です。
手順を示していただいたことで、どこからどうやって手を付けていいかわからない状態から
脱することができました。ありがとうございます。
ただ、今まで簡単な改修しか行ったことがありません。
調べつつ進めてみましたが、上記(5)〜の所で詰まってしまいました。
因みに、シート名が苗字だけだったので
月報ブックL9の名前を参照したいと考えています。
■現時点でわからないところ
1.開いたブックのシートをループ処理する際の記載方法
2.月報ブックC46:D53(工事Noと工事名称)の、データがあるところまでをC3〜コピペする方法
併せて月報ブックL9(名前)も同じ行までコピペする方法
(月報ブックの54行目には別のデータが入っています)
3.次シートの同じ作業を、2の最終行の次から行う方法
数時間かけてほんのさわりしかできませんでしたが、以下に(1)〜(4)を記載します。
Sub 個人別一覧表作成()
'シート追加
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Range("B5") & Range("C5") '月報ファイルを開く Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") Workbooks.Open OpenFileName
また、本コメント中においてコードの文字サイズが変な箇所があると思うんですが
統一する方法はございますでしょうか。
(hana) 2021/01/27(水) 11:10
>>また、本コメント中においてコードの文字サイズが変な箇所があると思うんですが >>統一する方法はございますでしょうか。 行の先頭を半角スペースにすると、スペースも認識され、細文字モードでみやすいですよ。連続している間効いています。
一行開けるともとに
また半角スペースいれればいいですよ。 (隠居じーさん) 2021/01/27(水) 12:00
ありがとうございます。
活用させていただきます。
(hana) 2021/01/27(水) 13:02
↓を【ステップ実行】してみて動きを確認したあと、判らない命令があればネット検索してみて、それでも判らなければどの部分がわからないか教えてください。
Sub 個人別一覧表作成_改() Dim OpenFileName As String Dim dstSH As Worksheet, dstRNG As Range Dim srcWB As Workbook, srcRNG As Range Dim i As Long
Stop 'ブレークポイントの代わり
With ActiveSheet 'シート追加(して変数にセット) Set dstSH = Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
'(末尾に追加した)シートの名前を変更 dstSH.Name = .Range("B5").Value & .Range("C5").Value
Set dstRNG = dstSH.Range("C3") End With
'ダイアログを表示して月報ファイルを選んでもらう OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
If OpenFileName = "False" Then 'ファイルが選択されなかったら処理終了 MsgBox "ファイルが選択されませんでした" Exit Sub Else '月報ファイルを開く(とともに、変数にセットする) Set srcWB = Workbooks.Open(OpenFileName) End If
'【ループ処理】 For i = 1 To srcWB.Worksheets.Count - 1 With srcWB.Worksheets(i) Set srcRNG = .Range("C46", .Cells(.Cells(.Rows.Count, "C").End(xlUp).Row, "I")) End With
dstRNG.Offset(, -2).Resize(srcRNG.Rows.Count).Value = srcWB.Worksheets(i).Name srcRNG.Copy dstRNG
Set dstRNG = dstRNG.Offset(srcRNG.Rows.Count) Next i
'■並び替え '■重複項目をクリア
End Sub
(もこな2) 2021/01/27(水) 15:41
Sub 個人別一覧表作成_改() Dim OpenFileName As String Dim MySH As Worksheet Dim dstSH As Worksheet, dstRNG As Range Dim srcWB As Workbook, srcRNG As Range Dim i As Long Dim 最終行 As Long
Stop 'ブレークポイントの代わり
Set MySH = ActiveSheet
'▼-----ダイアログを表示して月報ファイルを選んでもらう----- OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If OpenFileName = "False" Then 'ファイルが選択されなかったら処理終了 MsgBox "ファイルが選択されませんでした" Exit Sub Else '月報ファイルを開く(とともに、変数にセットする) Set srcWB = Workbooks.Open(OpenFileName) End If '▲----------------------------------------------------------------
'▼-----出力用のシートを準備----------------------------------- Set dstSH = Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) dstSH.Name = MySH.Range("B5").Value & MySH.Range("C5").Value Set dstRNG = dstSH.Range("C3") '▲----------------------------------------------------------------
'▼-----【ループ処理】---------------------------------------------- For i = 1 To srcWB.Worksheets.Count - 1 With srcWB.Worksheets(i) 最終行 = .Cells(.Rows.Count, "C").End(xlUp).Row If 最終行 > 45 Then Set srcRNG = .Range("C46:I" & 最終行) dstRNG.Offset(, -2).Resize(srcRNG.Rows.Count).Value = srcWB.Worksheets(i).Name srcRNG.Copy dstRNG End If End With Next i '▲----------------------------------------------------------------
'■稼働日数×7.5の計算 '■並び替え '■重複項目をクリア End Sub
(もこな2) 2021/01/28(木) 08:05
私が手を加えた点は
・出力用シートの準備を手前に持ってきました
(月報ファイルを開いた後だと、月報ファイル側で動作してしまいました。)
・ペーストを値にしました。
(元データが関数ということを伝え忘れていました。)
・ループ処理の最後に以下を追加しました。
Set dstRNG = dstRNG.Offset(srcRNG.Rows.Count)
(昨日のコメントにあったものを流用しました。ここが一番勉強になりました。)
また、現状報告ですが
・C列が空白の行を削除する
という処理を、見よう見まねで追加してみました。
'不要行削除 Dim dlt As Long Dim toprow As Long Dim bottomrow As Long '開始する行 toprow = 1 '終了する行 With dstSH bottomrow = .Cells(.Rows.Count, 3).End(xlUp).Row End With For dlt = bottomrow To toprow Step -1 If dstSH.Range("C" & dlt) = "" Then 'C列が空白なら行削除 dstSH.Rows(dlt).Delete End If Next 殆どコピペのようなものですが、自分で書いたコードが動くのはうれしいですね。 改善点等ございましたらご教示ください。
また、調べてもわからない箇所が出てくるかと思いますので、頼らせてください。
(hana) 2021/01/28(木) 11:37
■2
>ペーストを値にしました。
どのようなアプローチにしたかわかりませんが出来たならOKですね。
■3
>ループ処理の最後に以下を追加しました。
失礼しました。整理したときにうっかり忘れました・・・
■4
>改善点等ございましたらご教示ください。
ご自身が理解できるのが一番だと思いますので現状でよろしいんじゃないでしょうか
効率面で考えるなら、空白セルを覚えておいてから、当該セルを【含む行】をまとめて削除するとか、そもそも空白はコピーしないとかアプローチがあるとおもいます。
■5
もし、話を続けるのであれば現状のコードを示されたほうが良いと思いますが、それはそれとして、元データが関数ならEndプロパティを使った方法だと最終行が正しく取得できませんので別アプローチにしたほうがよいですね。
Sub 個人別一覧表作成_改二() Dim OpenFileName As String Dim MySH As Worksheet Dim dstSH As Worksheet, dstRNG As Range Dim srcWB As Workbook Dim i As Long Dim tmpRNG As Range
Stop 'ブレークポイントの代わり Set MySH = ActiveSheet
'▼-----ダイアログを表示して月報ファイルを選んでもらう----- OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If OpenFileName = "False" Then 'ファイルが選択されなかったら処理終了 MsgBox "ファイルが選択されませんでした" Exit Sub Else '月報ファイルを開く(とともに、変数にセットする) Set srcWB = Workbooks.Open(OpenFileName) End If '▲----------------------------------------------------------------
'▼-----出力用のシートを準備----------------------------------- Set dstSH = Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) dstSH.Name = MySH.Range("B5").Value & MySH.Range("C5").Value Set dstRNG = dstSH.Range("C3") '▲----------------------------------------------------------------
'▼-----【ループ処理】---------------------------------------------- For i = 1 To srcWB.Worksheets.Count - 1 With srcWB.Worksheets(i) Set tmpRNG = .Range("C46:C53").Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious)
If Not tmpRNG Is Nothing Then With .Range("C46:I" & tmpRNG.Row) dstRNG.Resize(.Rows.Count, .Columns.Count).Value = .Value dstRNG.Offset(, -2).Resize(.Rows.Count).Value = .Parent.Name Set dstRNG = dstRNG.Offset(.Rows.Count) End With End If End With Next i '▲----------------------------------------------------------------
'■稼働日数×7.5の計算 '■並び替え '■重複項目をクリア End Sub
(もこな2 ) 2021/02/07(日) 18:11
コメントありがとうございます。
一つできるようになると、どんどんやりたいことが増えて
今も合間を見て当該マクロを作り上げています。
>ちょっと意味がわかりませんが、出力用シートが月報ファイルに作成されたのでしょうか?
→仰る通りです。説明がわかりにくくてすいません。
>ご自身が理解できるのが一番だと思いますので現状でよろしいんじゃないでしょうか
>効率面で考えるなら、空白セルを覚えておいてから、当該セルを【含む行】をまとめて削除するとか、そもそも空白はコピーしないとかアプローチがあるとおもいます。
→確かに、今は1行ずつ削除しにいっているので、まとめて削除できると更に効率的になります。
ひとしきり完成したら、やってみようと思います。
>元データが関数ならEndプロパティを使った方法だと最終行が正しく取得できませんので別アプローチにしたほうがよいですね。
→そういった事もあるんですね、しっかり読み込んで組み込みます。
ほぼ知識0だった私に懇切丁寧に教えてくださり、本当にありがとうございました!
まだきっとこれからわからない箇所が出てくると思うので、その時は新たにスレッド(?)を建てようと思います。
(hana) 2021/02/08(月) 11:07
誤 Set dstSH = Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) 正 Set dstSH = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
↑のようにブックを指定しなかったため、アクティブブックが対象になってました。
■7
>ひとしきり完成したら、やってみようと思います。
一つの方法として研究用のコードを提供します。
Sub まとめて削除_研究用() Dim 行 As Long Dim 対象セル As Range Stop
With ActiveSheet '▼ループ処理でC列を順番に見ていき「空白」のセルがあれば「対象セル」に追加して覚えていく For 行 = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row If .Cells(行, "C").Value = "" Then If 対象セル Is Nothing Then Set 対象セル = .Cells(行, "C") Else Set 対象セル = Union(対象セル, .Cells(行, "C")) End If End If Next
'▼覚えたセルがあれば、当該セルを【含む行】を削除 If Not 対象セル Is Nothing Then 対象セル.EntireRow.Delete End With End Sub
ほかにも、オートフィルタで空白行を抽出してから削除というアプローチもありそうですね。
(もこな2 ) 2021/02/09(火) 04:45
また、EntireRowに関しても初めて見ましたが、Rangeオブジェクトを返すんですね
実際に触ってみて、Rowとの違いを感じてみようと思います。
(hana) 2021/02/09(火) 15:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.