[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コピー元のデーターが、コピー先ではなくコピー元に貼り付けられる』(ロンメル)
よろしくお願いします。
日報と月報という帳票があり、日報の合計値か平均値
(合計値がある場合は、合計値、無い場合は平均値)をコピーして、
月報に貼り付けるというマクロを組みました。
作成から今まで約半年程は問題なく動いていましたが、
先月突然、本来月報に貼り付けられるべき1日〜5日までの日報データーが、
日報の別セルに貼り付けられ、日報データが書き換えられてしまいました。
1日〜5日以外の日報では上記の不具合は発生しておらず、
何が悪いのか皆目見当が付きません。
申し訳有りませんが、ヒントだけでもご教示頂ければ幸いです。
下記、マクロのコードを貼り付けます。
For J = 1 To DayMax '日数カウント最大値(前日)まで処理を実行
Nippou = "D" + Format(Newdate, "yyyymm") + Format(J, "00") + ".xls" '日報ファイル格納 Workbooks.Open Pass & Name_nippou(1) & "\" & Nippou '日報オープン DoEvents
For K = 0 To 19 'コピーする行列数分処理を実行
Windows(Nippou).Activate 'コピー元(日報)をアクティブにする
If (Range("B41").Offset(1, K).Text = "-") Then 'コピー先が平均値か合計値かを判別
If Range("B41").Offset(0, K).Text = "" Or IsError(Range("B41").Offset(0, K)) Then
Cell(K, 1) = 1 'コピー先が空欄
Else
Cell(K, 1) = 0 'コピー先が空欄ではない Cell(K, 0) = Range("B41").Offset(0, K).Value '平均値を格納
End If
Else
If Range("B41").Offset(1, K).Text = "" Or IsError(Range("B41").Offset(1, K)) Then
Cell(K, 1) = 1 'コピー先が空欄
Else
Cell(K, 1) = 0 'コピー先が空欄ではない Cell(K, 0) = Range("B41").Offset(1, K).Value '合計値を格納
End If
End If
Next
Application.DisplayAlerts = False '確認メッセージ非表示 Windows(Nippou).Activate 'コピー先(日報)をアクティブにする ActiveWindow.Close 'コピー元(日報)を閉じる Application.DisplayAlerts = True '確認メッセージ表示
For K = 0 To 19 'コピーする行列数分処理を実行
If (Len(Range("B14").Offset(0, K)) <> 0) Then 'コピー先が空欄かを判別
If (Cell(K, 1) = 0) Then 'コピー先が空欄ではない
Windows(Geppou).Activate 'コピー先(月報)をアクティブにする Range("B18").Offset(J - 1, K).Value = Cell(K, 0) '数値の貼付け
Else
Windows(Geppou).Activate 'コピー先(月報)をアクティブにする Range("B18").Offset(J - 1, K) = " " '数値の貼付け
End If
End If
Next
Windows(Geppou).Activate 'コピー先(月報)をアクティブにする Application.DisplayAlerts = False '確認メッセージ非表示 ActiveWorkbook.Save 'コピー先(月報)を保存 Application.DisplayAlerts = True '確認メッセージ表示
Next
< 使用 Excel:Excel2013、使用 OS:Windows7 >
そういう時は、F8キーでステップ実行をして自分で確認する習慣をつけましょう。
(BJ) 2018/10/16(火) 11:48
RangeやCellsの前にWorksheetオブジェクトを明示すれば、そのような問題はまず起こりません。
(名無し) 2018/10/16(火) 12:05
部分的にしか提示されていないのでよくわからないですが、少なくとも複数のシート(ブック)が絡んでいるので、Range〜、Cells〜のように記述してある部分すべてについて、どのシートを指しているのか、明示するように修正したほうがよいでしょうね。
その過程で、「Withステートメント」について調べてみると、すっきりとしたコードにできるとおもいます。
(もこな2) 2018/10/16(火) 12:19
ご助言にそって、コード見直します。
助かりました。
(ロンメル) 2018/10/16(火) 12:59
Sub 無理やり整理() Dim J As Long, K As Long, DayMax As Long Dim Newdate As Date Dim MyPath As String 'フォルダパスの"パス"は「Path」です Dim Nippou As String Dim Name_nippou As Variant 'なんで配列にしてるのかわからないけど、とりあえず・・
Dim dstWB As Workbook '← 追加
'「日数カウント」とは何かわからないが、変数名から妄想 Newdate = "2016/9/16" DayMax = Format(DateSerial(Year(Newdate), Month(Newdate) + 1, 0), "d")
'前記のとおりなぜ配列なのかよくわからないが・・・ Name_nippou = Array("フォルダ1", "フォルダ2") MyPath = ThisWorkbook.Path & Name_nippou(1) & "\" '←適宜変更のこと
For J = 1 To DayMax '日数カウント最大値(前日)まで処理を実行
'文字列の結合は「&」で! With Workbooks.Open(MyPath & "D" & Format(Newdate, "yyyymm") & Format(J, "00") & ".xls") '日報オープン
'DoEvents ←何のために入れてるのか不明 '↓シートを明示するなら(ActiveSheetに頼らないなら)要らない 'また、どうしても書くにしてもループの外に置くべき 'Windows(Nippou).Activate With .Worksheets(1) '← シートは適当なので適宜修正のこと
For K = 0 To 19 'コピーする行列数分処理を実行 If .Range("B41").Offset(1, K).Text = "-" Then 'コピー先が平均値か合計値かを判別 If .Range("B41").Offset(0, K).Text = "" Or IsError(.Range("B41").Offset(0, K)) Then .Cell(K, 1) = 1 'コピー先が空欄 Else .Cell(K, 1) = 0 'コピー先が空欄ではない .Cell(K, 0) = .Range("B41").Offset(0, K).Value '平均値を格納 End If Else If .Range("B41").Offset(1, K).Text = "" Or IsError(.Range("B41").Offset(1, K)) Then .Cell(K, 1) = 1 'コピー先が空欄 Else .Cell(K, 1) = 0 'コピー先が空欄ではない .Cell(K, 0) = .Range("B41").Offset(1, K).Value '合計値を格納 End If End If Next End With
.Save '日報ブックを上書き保存(元コードにはないが、日報ブック内を書き換えてるから保存せずに閉じたら意味が無い) .Close '日報ブックを閉じる(直前に保存処理してるから確認メッセージはそもそも出ないハズ) End With
'同じ話だが唐突に月報ブックを操作してるので、その辺もちゃんと明示(修飾)すべき '日報ブックを閉じたあと、何がActiveになっているつもりだったのかわからないけど '月報ブックにこのマクロが書いてあるとして・・・ With ThisWorkbook.Worksheets(1) For K = 0 To 19 'コピーする行列数分処理を実行 If (Len(.Range("B14").Offset(0, K)) <> 0) Then 'コピー先が空欄かを判別 If (.Cell(K, 1) = 0) Then 'コピー先が空欄ではない .Range("B18").Offset(J - 1, K).Value = Cell(K, 0) '数値の貼付け Else .Range("B18").Offset(J - 1, K) = " " '数値の貼付け End If End If Next
'月報ブックを初めて保存するのではないのだろうから、 '「DisplayAlerts」を制御する必要がなさそうな気がするのは私だけ? Application.DisplayAlerts = False '確認メッセージ非表示 ActiveWorkbook.Save 'コピー先(月報)を保存 Application.DisplayAlerts = True '確認メッセージ表示 End With Next
End Sub
こんな感じで、提示のコードだと、同じシート内でコピペするようになっているので、
日報を月報に集約するマクロのイメージであれば、根本的に見直す必要がありそうな気がします。
(もこな2) 2018/10/17(水) 04:18
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.