[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『日報から月報転記（実績数値のみ）』（おやじさん）
作業日報を作成したのですが、
上司より,「月報でﾃﾞｰﾀの蓄積を作って」との依頼があり困っています。
日報
例
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
1 作業日 5/6
2 予定数 実 績 不 良 進 捗 コメント
3 製品Ａ 1000 800 7 -200
4 製品Ｂ
5 製品Ｃ
以上 製品6ﾀｲﾌﾟ B3～E8に数値を記入
日報は毎回上書き
月報(別ｼｰﾄ）
例
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ ・・・・・・AG
1 5/1 5/2 5/3 5/4 5/6 5/31
2 製品Ａ予定数 1000
3 実 績 800
4 実績累計 100 900
5 不 良 7
6 進 捗 -200
以下製品Ｂ～Ｆ続きます。
月報C2～AG31が転記欄 日付は毎月更新 A2～B31は固定されています。
累積と進捗は計算させるので、実際の転記は予定数/実績/不良を
日報から転記させたいと思っています。
（日報 横表記に対し、月報（転記）は、縦表記になり
かつ1行（実績累計）間に入ります。）
関数等で考えましたが、自分の能力では、出来ませんでした。
ﾏｸﾛ等での転記方法を教えて下さい。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
Sub test()
Dim wsD As Worksheet
Dim wsM As Worksheet
Dim k As Long
Dim myDate As Long
Dim myProduct As String
Dim myRow As Long
Dim myCol As Long
Set wsD = Worksheets("日報")
Set wsM = Worksheets("月報")
myDate = wsD.Cells(1, 2).Value2 ' 日付
'日付のマッチした列
myCol = Application.Match(myDate, wsM.Rows(1))
For k = 3 To wsD.Cells(wsD.Rows.Count, 1).End(xlUp).Row
myProduct = wsD.Cells(k, 1).Value ' 製品名
'製品名のマッチした行
myRow = Application.Match(myProduct, wsM.Columns(1))
'転記
With wsM.Cells(myRow, myCol)
.Value = wsD.Cells(k, 2).Value
.Offset(1).Value = wsD.Cells(k, 3).Value
.Offset(3).Value = wsD.Cells(k, 4).Value
.Offset(4).Value = wsD.Cells(k, 5).Value
End With
Next
End Sub
エラー対応などは省略しています。そちらでどうぞ。 # 月報に直接入力していけないものかなあ。 # 日報は上書きだというが、それって大丈夫？ # 記録として保存する必要があるように思いますが。
（γ） 2015/05/23(土) 16:44
（おやじさん） 2015/05/25(月) 16:52
エラー処理を追加しました。試してみて下さい。
Sub test2()
Dim wsD As Worksheet
Dim wsM As Worksheet
Dim k As Long
Dim myDate As Long
Dim myProduct As String
Dim myRow As Variant ' ■注意: 型を変更 ■
Dim myCol As Variant ' ■ 型を変更 ■
Set wsD = Worksheets("日報")
Set wsM = Worksheets("月報")
myDate = wsD.Cells(1, 2).Value2 ' 日付
'日付のマッチした列
myCol = Application.Match(myDate, wsM.Rows(1), 0)
' エラー処理
If IsError(myCol) Then
MsgBox wsD.Cells(1, 2).Text & "はマッチしませんでした"
Exit Sub
End If
For k = 3 To wsD.Cells(wsD.Rows.Count, 1).End(xlUp).Row
myProduct = wsD.Cells(k, 1).Value ' 製品名
'製品名のマッチした行
myRow = Application.Match(myProduct, wsM.Columns(1), 0)
' エラー処理
If IsError(myRow) Then
MsgBox myProduct & "はマッチしませんでした。終了します。"
Exit Sub
End If
'転記
With wsM.Cells(myRow, myCol)
.Value = wsD.Cells(k, 2).Value
.Offset(1).Value = wsD.Cells(k, 3).Value
.Offset(3).Value = wsD.Cells(k, 4).Value
.Offset(4).Value = wsD.Cells(k, 5).Value
End With
Next
End Sub
# Matchの照合の型を指定しておらず失礼しました.
（γ） 2015/05/25(月) 20:36
それと申し少し勉強して理解出来るよう頑張ります。
ありがとうございました。
（おやじさん） 2015/05/25(月) 21:48
> 最後に確認ですが、 > 問題なく転記して > 最後に > 「はマッチしませんでした。終了します。」の表示で > ＯＫを押して 終了になるのでしょうか？
問題なく転記してあれば、何のメッセージも出ません。
「はマッチしませんでした。終了します。」の表示が出るということは、 メッセージどおり、商品名（か日付が）マッチしなかったということです。
（正常終了のメッセージを出したければ、
最後の行に （つまりEnd Sub の直前に）
MsgBox "エラー無く終了しました。おめでとう"
を入れて下さい。）
（γ） 2015/05/25(月) 22:06
最後に質問です、申し訳ありませんが
日報の日付位置が変更 Ｂ１ → Ｉ3になり（修正）
それに伴い製品名・ﾃﾞｰﾀ位置も変更になります。
Ｂ Ｃ Ｄ Ｅ
5 予定 実績・・・・・
6 製品Ａ 1000 800 ・・・・
7
又月報も1行目に1行挿入になります。
一応自分なり変更箇所を修正したつもりですが、
途中まで転記されてｴﾗｰ表示になります。
「製品Ｄはﾏｯﾁしませんでした。終了します。」
しつこくて申し訳ありません。
ご回答いただければ助かります。
（おやじさん） 2015/05/26(火) 15:00
> 一応自分なり変更箇所を修正したつもりですが、 > 途中まで転記されてｴﾗｰ表示になります。 > 「製品Ｄはﾏｯﾁしませんでした。終了します。」 そのコードを示してください。
私の役目はコードを示した時点で終わっていて、 そうした修正は質問者さんにおいて実行して欲しいと思っています。 そういう修正ができないわけがありません。 そういう作業まで、こちらにさせるのですか？
（γ） 2015/05/26(火) 21:37
（おやじさん） 2015/05/26(火) 22:17
日報シートの A3 と 月報シートの A10が一致するはずなのに 一致せずにエラーになるなら、 日報シートのどこかのセルに = A3 = 月報!A10 としてTrueが返るか確認して下さい。
よくあるのは、前後に半角スペースが入っていたりして、 見かけは一致しているが、実は不一致とかのケース。 全角半角の見間違いもあるかも知れない。
よく確認してください。 上手く転記できるところもあるということなら、 コードが全く間違っているわけでもないと思います。 むろん、私は動作確認して投稿しましたが。
（γ） 2015/05/27(水) 07:49
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.