[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件付き書式を上書きしないで貼り付けたい』（赤由良）
何度もすみません。 内容が変化するので新しくトピックスを立てました。 [[20181108100108]] このトピックスに記載しましたが、表の右隣にマクロで貼り付けされたデータをそのまま左にドラッグして元表を上書きしたのですが、そうすると元表の範囲に指定していた条件付き書式も上書きされて消えてしまうことに気が付きました。調べるとこういう場合は上書きされるのですね。 値で貼り付ければ条件付き書式はそのままですが、切り取った場合は値で貼り付けができない。なのでAN以降に貼り付けされたデータを選択、コピー、B1に値で貼り付け、元データを削除。このような手順を踏みます。 私一人なら問題ありませんが複数人が使うものなので単純化を図りたいです。 何か良いアイディアをいただけないでしょうか。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
前のトピックはロクに読んでいませんが、表の右隣への貼り付けをマクロを使ってやったのなら、 ついでに、左隣の書式を右にコピーしておけばいいんじゃないですか・・・アイデアだけですけど。
（半平太） 2018/11/09(金) 20:37
Sub test()
Dim wk1 As Worksheet
Dim wk2 As Worksheet
Dim dw As Date
Dim i As Long
Set wk1 = Sheets("Sheet1")
Set wk2 = Sheets("Sheet2")
dw = wk1.Range("B1").Value
For i = 5 To wk2.Cells(1, wk2.Columns.Count).End(xlToLeft).Column
If dw = wk2.Cells(1, i).Value Then
Exit For
End If
Next i
wk1.Range("B3:AM32").Copy
wk2.Cells(3, i).PasteSpecial Paste:=xlPasteValues
End Sub
このマクロを作成していただきました。(元表を修正したので数値を変えてます)
まだしっかりとコード内容を理解していない為理解は不十分ですが、
sheet1の表(B1からAM32)をsheet2の一行目(日付行)とsheet1のB1の日付が一致する列に値で貼りつける。このような内容だと推測してます。(繰り返しますが勉強中なので間違えていたらすみません)
前述したトピックで記載した通り今年の10月のように月曜日から始まる場合だと表範囲の右、AN列から表が貼り付けされます。
ただ右側に貼り付けされた表をそのまま左にドラッグして上書きすればいい話ですし上のコードを理解してないのに修正してくれと言うのは申し訳なく抵抗がありました。
ところがそれだと条件付き書式が上書きされることが判明したので、このトピックを作成しました。
回りくどくすみませんでした。
（赤由良） 2018/11/09(金) 22:18
中間に手作業を絡める必要性は一切なく、マクロで全て処理できることなんですね？
それにしてもよく分かんないですね。
何故、望んでもいないAN列に貼り付けることになったんですか？
AN1が10/1だったからですか？
なら、何故、そんなところに10/1が入ったままにしているんですか？
あと、E3は月曜日なんですよね。
でも、AM1が9/30なら、逆算するとE3は8/23（木曜日）ですよ。
もう少し、辻褄が合うように説明してください。
こんなのは簡単なことなんで、そんなに気を使わなくてもいいですよ。 キチンと希望を書いてもらえば簡単にできます。
（半平太） 2018/11/09(金) 23:09
＞ あと、E3は月曜日なんですよね。 ＞ でも、AM1が9/30なら、逆算するとE3は8/23（木曜日）ですよ。
すみません。間違えました。8/27日（月曜日）でした m(__)m
すると、書き出す位置は自動的に求まります。
残る疑問は、何故AN1セルを10/1のまま放置してあるのか、ですね。
（半平太） 2018/11/09(金) 23:39
衝突しましたがそのまま上げます。
>何故、望んでもいないAN列に貼り付けることになったんですか？ >もう少し、辻褄が合うように説明してください。 順を追って説明します。
sheet1 A列に氏名、B1からAM32が表、一行目が日付。二行目が曜日。B1は1日が入る。 sheet2 構成はsheet1と同じ。ただB1には１日じゃなく先月の最後の月曜日の日付が入る。
やりたいこと。
先月の表(現在作成してるブックとは別のブック。ブック1と仮称)から月の最後の月曜日から最終日をコピー。作成してるブック(ブック2)のsheet2のB3に貼り付け。(sheet2に日付、曜日は入力済み) sheet1のB1からのデータを選択してsheet2の１日部分に貼り付ける。 来月はこのsheet2のデータの月末をコピーしてブック1のsheet2に･･･とこれを繰り返す。 恐らく何故ブックを分けてるのだとか色々突っ込み処があると思いますが、ブックのシート数が多いなど理由がありブックを月で分けて交互に使ってます。
>こんなのは簡単なことなんで、そんなに気を使わなくてもいいですよ。
このようなことも可能ですか？ ブック2のsheet2にブック1のsheet2の最後の月曜日から最終日までを貼り付け。その隣に同じブック2のsheet1の表を貼り付ける。条件付き書式を上書きしないように値で貼り付ける。
説明が長くすみません。しっかり説明できてるか不安です。よろしくお願いします。 （赤由良） 2018/11/10(土) 00:26
＞恐らく何故ブックを分けてるのだとか色々突っ込み処があると思いますが、
月替りに、データ移動の工夫が必要なんだろうなぁとは思っていましたよ。
最終的にやりたいことは以下ですね？
（1）ブック1のsheet2の最後の月曜日から最終日までを ブック2のsheet2のB1以下に貼り付ける。〈※） （2）その右隣に、同じブック2のsheet1のB列からの表を付ける。
（※）ただし、（A）月末が日曜日の場合、コピーは必要なく、上記（2）の貼り付けはB列から行う。 もしくは（B）月末が日曜日の場合も同様。したがって、その時は、前月最終1週間分をコピーする。 （A）、（B) どっちですか？
（半平太） 2018/11/10(土) 12:30
こちらの過不足分まで考慮していただきありがとうございます。 最初は単純に(1)だと思ってたんですが、考えてみると月から日曜日で一週間ぴったり切れるのは問題がありました。なので(2)でお願いします。ご指摘ありがとうございます。 （赤由良） 2018/11/10(土) 13:20
使い方
１．今月ブック（ブック1とブック2は毎月交互に「今月」ブックの役割となる）の Sheet1のB1セルに今月1日の日付を入れて通常作業をする。
例：2018/9/1
２．転記したいタイミングになったら、相方のブックも開いてから、 今月ブックのSheet1のB1セル（上記1で日付を入力したセル）を右クリックする。
３．すると「転記を開始します」というメッセージが出るので、「OK」ボタンをクリックする。
４．あとは、マクロが自動処理してくれます。
関連ブック名とシート名は以下とします。
ブック名は、ブック1.xlsm 、ブック2.xlsm シート名は、Sheet1 、Sheet2 と仮定していますので、実際に合わせて修正してください。
両ブックの各Sheet1の「シートモジュール」に下記マクロ（同じもの）を貼り付ける ↑ ※「標準モジュール」への貼り付けではないので留意してください。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address(0, 0) <> "B1" Then
Exit Sub
ElseIf Target.Value < DateSerial(2000, 1, 1) Then '日付が2000以前はミスのハズ
MsgBox "B1セルの日付が古すぎです。処理中止"
Exit Sub
ElseIf Day(Target.Value) <> 1 Then '日付が月初じゃない
MsgBox "B1セルの日付は月初日にしてください。処理中止"
Exit Sub
ElseIf MsgBox("転記を開始します", vbOKCancel) = vbCancel Then
Exit Sub
Else '転記処理実行
Cancel = True
Call copyNpaste(Target.Value) '初日を渡して実行
End If
End Sub
Private Sub copyNpaste(Fday As Date)
Const RowsToProc As Long = 32 '当面の処理対象行数
Dim Ws1 As Worksheet, Ws2 As Worksheet '今月ブック
Dim AltBKname As String, AltWs As Worksheet '相棒のブック名とシートオブジェクト
Dim B1date As Date '今月ブックのシート2のB1セルの日付＝前月最終月曜日
With ThisWorkbook
Set Ws1 = .Sheets("Sheet1")
Set Ws2 = .Sheets("Sheet2")
End With
AltBKname = IIf(ThisWorkbook.Name = "ブック1.xlsm", "ブック2.xlsm", "ブック1.xlsm")
Set AltWs = Workbooks(AltBKname).Sheets("Sheet2")
B1date = Fday - Ws1.Evaluate("MOD(WEEKDAY(B1,3)-1,7)+1") '前月最終月曜日
'前月関連処理
Dim lastMndInAlt As Long '前月最終月曜の列番
Dim PreEOMonth As Date '前月最終日付
Dim lastMonthColLen As Long '前月からコピーすべき列数
lastMndInAlt = Application.Match(CLng(B1date), AltWs.Rows(1), False)
PreEOMonth = DateSerial(Year(Fday), Month(Fday), 0)
lastMonthColLen = PreEOMonth - B1date + 1
'前月最終月曜日関連をコピぺ
Debug.Print AltWs.Cells(1, lastMndInAlt).Resize(RowsToProc, lastMonthColLen).Copy
Ws2.Range("B1").PasteSpecial Paste:=xlPasteValues
'今月関連処理
Dim ThisMonthColLen As Long '今月の日数
ThisMonthColLen = Day(DateSerial(Year(Fday), Month(Fday) + 1, 0))
Ws1.Range("B1").Resize(RowsToProc, ThisMonthColLen).Copy
Ws2.Cells(1, lastMonthColLen + 2).PasteSpecial Paste:=xlPasteValues 'A列分を1列水増し
'今月より右は不要につき、クリア
Ws2.Columns(lastMonthColLen + ThisMonthColLen + 2).Resize(RowsToProc, 100).ClearContents
End Sub
（半平太） 2018/11/10(土) 18:43
Call copyNpaste(Target.Value) '初日を渡して実行
当初この部分をCellとミスしたらコンパイルエラー Function または変数が必要です とメッセージが出ました。そのときはcopyNpasteの部分が青字になったのですぐにわかったのですが、修正してからは右クリックしても反応がないです。
ご迷惑お掛けします。
（赤由良） 2018/11/10(土) 20:44
＞スペルミスの他にはどういった原因があるのでしょうか。
コピペしなかったんですか？
手打ちは止めてください。正確に打てっこないです。
そんな事で旨く行かないなんて言われても、 考えるだけエネルギーの浪費です。
でも、これを守っていれば、何の反応もない等と言う事はあり得ないですけどねぇ・・ ↓ （１）Sheet1のB1セルを右クリックしましたか？ （２）マクロは、Sheet1のシートモジュールに書きましたか？
（半平太） 2018/11/10(土) 21:34
横からだけど、原因は小文字入力ではなく、単なるタイプミスです。
なので↓を読んで、変数宣言を強制することを強くお勧めします。
http://officetanaka.net/excel/vba/variable/02.htm
http://officetanaka.net/excel/vba/beginner/06.htm
（もこな２） 2018/11/11(日) 12:39
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.