[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『(マクロ)セルの作表方法について』(マイン)
お世話になっております。
日曜日のあるセルを取得し「5行目:7行目」と「60行目」に着色する方法について
Unionを使用した記述方法についてアドバイスをお願いいたします。
下記コードは
ActiveSheet内の勤務表を祝祭日に応じて罫線と着色をおこなうものです。
・5行目のカレンダー日付部分から日曜日を判別
→日曜日の右側に罫線を引く(日と月の区切りがわかりやすくするため)
・5行目のカレンダー日付がマスタ内の休日リストに該当したら1行目の作業セルに関数で「1」を表示させ
→その休日のある列に着色
上記について、ループで対象となるセルをUnionで格納して一気に作表させております。
現在のコードでは、5行目から90行目までの連続した範囲を指定していますが
冒頭にあるように、範囲を2つにして「5行目:7行目」と「60行目」としたく模索中です。
※Unionを使用しているのは処理速度が速かったため使用しています。
※セルの条件付き書式は、都合上あえて使用していません。
皆様アドバイスの程よろしくお願いいたします。
Sub カレンダー作表()
With ActiveSheet '★最終列取得 Dim col As Long 'カレンダーの最終列定数 'AJ=4行目の36列目から左に検索(4行目には曜日番号がある) For col = .Cells(4, 36).End(xlToLeft).Column To 1 Step -1 'セルを順次左方向に値が""以外のセルに到達したら終了 If .Cells(4, col) <> "" Then Exit For Next col '★着色と罫線の初期化 With .Range("E5:AI90") .Borders(xlInsideVertical).Weight = xlHairline '極細 .Interior.ColorIndex = 0 '無色 End With
'★作表範囲の取得
Dim MyColor As Range '着色:休日セルに着色 Dim MyKei As Range '罫線:日曜右セルに設置 Dim c As Long For c = 5 To col '列5列目〜31列目まで処理 行固定(公休判断行は5行目)
'★カレンダーから日曜日を判定し罫線を設置 If Weekday(.Cells(5, c)) = vbSunday Then If MyKei Is Nothing Then '※Unionに番地を格納 Set MyKei = .Range(.Cells(5, c), Cells(90, c)) Else Set MyKei = Application.Union(MyKei, .Range(.Cells(5, c), Cells(90, c))) End If End If
'★公休着色:作業行1行目にある日付関数で休日マスタから休み該当=1表示を取得し処理 If .Cells(1, c) = 1 Then If MyColor Is Nothing Then Set MyColor = .Range(.Cells(5, c), Cells(7, c)) Else Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), Cells(7, c))) End If End If Next c End With
Application.ScreenUpdating = False
'★上記から処理判定し実際に作表
If MyKei Is Nothing Then Exit Sub With MyKei .Borders(xlEdgeRight).Weight = xlThin '細 End With If MyColor Is Nothing Then Exit Sub With MyColor .Interior.ColorIndex = 36 'うす黄色 End With
Application.ScreenUpdating = True End Sub
< 使用 Excel:Office365、使用 OS:Windows10 >
If MyColor Is Nothing Then Set MyColor = .Range(.Cells(5, c), Cells(7, c)) Else Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), Cells(7, c))) End If End If
↑に60行目も加えればいいでしょう。
あと、With ActiveSheet なので問題はでませんが、
.Range(.Cells(5, c), Cells(7, c)) ↓ .Range(.Cells(5, c), .Cells(7, c))
を推奨します。
(もこな2) 2019/06/25(火) 08:49
ご指摘ありがとうございました
「.」抜けていました。単純なミスです。
60行目も加える方法ですが
Set MyColor = .Range(.Cells(5, c), Cells(7, c))
Set MyColor = MyColor & .Cells(60,c)
Else
ということでしょうか?
見当違いのこと言っていたらすみません。
(マイン) 2019/06/25(火) 09:15
(1)
>見当違いのこと言っていたらすみません。
そんなこと書くらいなら、まずは自分でテストしてみてはどうでしょうか?
Sub test()
Dim MyRNG As Range
Set MyRNG = Range("A1:D2") Set MyRNG = MyRNG & Range("A60:D60")
Debug.Print MyRNG.Address(0, 0)
End Sub
【−−以下は、自分で上記コードをテストしてみてから読んでください−−】
(1)のつづき
Unionメソッドを理解されているならこうすればよいことに気づけるはずです。
Sub test()
Dim MyRNG As Range
Set MyRNG = Range("A1:D2") Set MyRNG = Union(MyRNG, Range("A60:D60"))
Debug.Print MyRNG.Address(0, 0)
End Sub
なお、「※Unionに番地を格納」とコメントをつけていますが、番地(アドレス)ではなく、Union【メソッド】を使って、【オブジェクト型の変数】に複数の「セル(範囲)」そのものを格納しています。
(2)
「.」を忘れたのは単純ミスとのことですが、質問の形式で追加提示されたものも抜けてますよ。
(3)
このほか↓の部分について
If MyKei Is Nothing Then Exit Sub With MyKei .Borders(xlEdgeRight).Weight = xlThin '細 End With If MyColor Is Nothing Then Exit Sub With MyColor .Interior.ColorIndex = 36 'うす黄色 End With
「MyKei」がNothingで、「MyColor」がNothingでなかったらどうするんですか?
※流し読みしたので、私が見落としているだけで、もともと「MyKei」がNothingになる場合は「MyKei」もNothingになる 設計になっているのでしたら、余計なツッコミごめんなさい。
ちなみに、私ならWithステートメントを使う意味もなさそうですし、このようにします。
If Not MyKei Is Nothing Then MyKei.Borders(xlEdgeRight).Weight = xlThin '細 End If If Not MyColor Is Nothing Then MyColor.Interior.ColorIndex = 36 'うす黄色 End If
(4)
どうでもよいツッコミですが、
「ColorIndex = 36 'うす黄色」
カラーパレットの36番目が【うす黄色】であるかは環境(設定)に依存しますから、確実にうす黄色にしたいなら、ちゃんと指定した方が安心かなぁとおもいます。
http://officetanaka.net/excel/vba/graph/24.htm
(もこな2) 2019/06/25(火) 12:07
アドバイスありがとうございます。
Set MyColor = .Range(.Cells(5, c), Cells(7, c))
Set MyColor = MyColor & .Cells(60,c)
エラーになりました。
アドバイスを元に以下の通り修正したら
・色設定の箇所
・色の曖昧な設定をやめてRBGで設定
以上を修正したら思い通りの動作が可能となりました。
感謝申し上げます。
手動計算・描画停止を入れても
条件付き書式に比べて一瞬ですが
もっさりとした動きは仕様上目をつぶるしかなさそうです。
Sub カレンダー作表()
With ActiveSheet '★最終列取得 Dim col As Long 'カレンダーの最終列定数 'AJ=4行目の36列目から左に検索(4行目には曜日番号がある) For col = .Cells(4, 36).End(xlToLeft).Column To 1 Step -1 'セルを順次左方向に値が""以外のセルに到達したら終了 If .Cells(4, col) <> "" Then Exit For Next col '★着色と罫線の初期化 With .Range("E5:AI90") .Borders(xlInsideVertical).Weight = xlHairline '極細 .Interior.ColorIndex = 0 '無色 End With '★作表 Dim MyColor As Range '公休の着色 Dim MyKei As Range '日曜右セルに罫線 Dim c As Long 'カレンダー行カウント用変数 For c = 5 To col '列5列目〜31列目まで処理 行固定(公休判断行は5行目) '★カレンダーから日曜日を判定し罫線を設置 If Weekday(.Cells(5, c)) = vbSunday Then If MyKei Is Nothing Then '※Unionに番地を格納 Set MyKei = .Range(.Cells(5, c), .Cells(90, c)) Else Set MyKei = Application.Union(MyKei, .Range(.Cells(5, c), Cells(90, c))) End If End If '★公休着色:作業行1行目にある日付関数で休日マスタから休み該当=1表示を取得し処理 If .Cells(1, c) = 1 Then If MyColor Is Nothing Then Set MyColor = .Range(.Cells(5, c), .Cells(7, c)) Set MyColor = Application.Union(MyColor, .Range(.Cells(60, c), Cells(60, c))) Else Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), Cells(7, c))) Set MyColor = Application.Union(MyColor, .Range(.Cells(60, c), Cells(60, c))) End If End If Next c End With Application.ScreenUpdating = False '描画停止 Application.Calculation = xlCalculationManual '手動計算 '処理判定し実際に作表 If Not MyKei Is Nothing Then MyKei.Borders(xlEdgeRight).Weight = xlThin '細 End If If Not MyColor Is Nothing Then MyColor.Interior.Color = RGB(255, 167, 255) 'うすめピンク End If
Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
(マイン) 2019/06/26(水) 08:37
(6)
よくわかりませんが、↓って該当列の1行目が「1」になってるってことですか?
'★公休着色:作業行1行目にある日付関数で休日マスタから休み該当=1表示を取得し処理
(7)
やってることとコメントが一致してません。
コメントのとおりだとすると処理の対象は【E〜AE列の固定】ではないですか?
For col = .Cells(4, 36).End(xlToLeft).Column To 1 Step -1 'セルを順次左方向に値が""以外のセルに到達したら終了 If .Cells(4, col) <> "" Then Exit For Next col For c = 5 To col '列5列目〜31列目まで処理 行固定(公休判断行は5行目) '(中略) Next c
ただ、初期化?しているのは、【E〜AI列の固定】になってますね
With .Range("E5:AI90") .Borders(xlInsideVertical).Weight = xlHairline '極細 .Interior.ColorIndex = 0 '無色 End With
(8)
>エラーになりました。
なるでしょうね。聞く前に試せばわかることですから、デバッグ作業や検証は人任せにせず、ご自身でちゃんとやるべきですよ。
ただ、そんなことより重要なのは、なんでエラーになったかは解るのでしょうか?
もっと言うと、なんで言ったとおりに直したらエラーにならなくなったのか理解されてますか? (たぶん型が一致しないというエラーが出たと思いますが、原因はそのまま、Range型の変数にそうでないものをぶち込むようにしていたためと思われます。) (エラーの種類が違っていたらごめんなさい。)
(9)
>手動計算・描画停止を入れても 条件付き書式に比べて一瞬ですが
>もっさりとした動きは仕様上目をつぶるしかなさそうです。
言いたいことがよくわかりません。
条件付き書式の方が早いと言いたいなら、まぁそうかもしれないですね。
マクロの方は、実行の度にイチからチェックしてから、書式をいじってますから・・
改善案としては、Changeイベントなどを使って、5行目に入力があったらその列だけ処理するという感じにすればよいとおもいますが、そのようにする場合でも、まずはこちらのマクロを完成させてから応用した方が良さそうです。
ところで、なんで計算方法を手動にするんでしょうか?
書式しか変えてませんからそもそも再計算は発生しないようにおもいますので狙いがわかりません。
(もこな2) 2019/06/26(水) 18:53
ご面倒をおかけしてすみません。
ご指摘大変勉強になっております。
(5)の部分ですが「.」修正しました。
エラーがでていなかったもので、完全に見落としです。
(6)の1行目の作業列は5行目の日付が別シートにある休日リスト(土日祝日一覧)の日付と一致した
関数で「1」を表示させています「E1=IF(ISNA(MATCH(E5,休日リスト,0)),"",1)・・・・AI1」
休日の着色は・・・下記の部分のコードで1行目を参照して「1」があれば休日と判断しています。
If .Cells(1, c) = 1 Then
If MyColor Is Nothing Then Set MyColor = .Range(.Cells(5, c), .Cells(7, c)) Set MyColor = Application.Union(MyColor, .Range(.Cells(60, c), .Cells(60, c))) Else Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), .Cells(7, c))) Set MyColor = Application.Union(MyColor, .Range(.Cells(60, c), .Cells(60, c))) End If End If
日曜日の右側に罫線を引くのは・・・5行目のカレンダー行から日曜日を
If Weekday(.Cells(5, c)) = vbSunday Then で判断しています。
(7)の範囲設定ですが、言われるとおりです。
処理対象のセル範囲は固定です。
他のマクロコードをそのままコピペして使いまわしていました。
余計に処理時間を引き伸ばしていました。
(8)は型が違うものを格納しようとしたことによるエラーメッセージでした。
(9)自動計算停止は、神頼み的に入れてしまいました。
よくよく考えると、再計算が必要な処理は休日判定で終わっているので意味がありませんでした。
(マイン) 2019/06/26(水) 23:43
ただ、提示されたことを踏まえると「休日リスト」と名前をつけたセル範囲に土日分も含めてリストを作ったんですよね?
Office365と仰っているので、NETWORKDAYS関数というものを使うと、休日分だけ(いちいち土日分を含めない)のリストで対応できますよ
http://www.kenzo30.com/ex_kisotyu/ex_ks_tyukyu9_9_3.htm
E1=NETWORKDAYS(E5,E5,休日リスト) E5が平日 → 1 E5が土日祝日 → 0
もとのように 「""」or「1」としたければ、↓でも大丈夫だとおもいます。
E1=IF(NETWORKDAYS(E5,E5,休日リスト),"",1)
また、返り値が論理値でも気にならないということであれば、↓でもよいですね【★1】
E1=NOT(NETWORKDAYS(E5,E5,休日リスト))
(7)の返答の返答
>言われるとおりです。
で、実際の範囲はどっちなんですか?【★2】
【E〜AE列の固定】or【E〜AI列の固定】
(8)の返答の返答
>型が違うものを格納しようとしたことによるエラーメッセージ
それ、もう私が言ってるじゃないですか・・・
肝心なのは、そのエラーメッセージが返ってきたときに「あっそっか〜間違っちゃった〜」と思って直すことができるのか(直す"方法"を覚える気があるのか)、そもそも自分で検証・修正する気は無くて、作成やデバッグ作業は無償で人にやってもらい完成品だけほしいのかどっちなんだろうということです。
※後者だとすると、このサイト的にNGではないようですが、私は請け負う気が無いので降りますから早めに言ってほしいです。
(9)の返答の返答
「神頼み」ってなんですか?
ScreenUpdatingも含めて、なんで高速化に寄与するのか調べ直した方がよいとおもいます。
(以前、おまじないと称して盲目的に付している方もいらっしゃいました。まぁ困りはしないのでしょうけど・・・)
また、個人的には、高速化は完成してからの話(無駄な動作の改善は別)だと思うのでScreenUpdating等は、トライ&エラーを繰り返している段階では入れない方がよいとおもいます。【★3】
(次投稿に続きます…が、少し間が開くかもしれません)
(もこな2) 2019/06/28(金) 09:07
(10)
研究用にサンプルコードを提供します。
丸写しはしないで、ステップ実行して研究のうえ必要と思われる部分だけご自身のコードに組み入れてください。
【★1】などの処置により対象列の1行目には[TRUE]か[0以外の"数値"]が、対象でない列の1行目には[FALSE]か[0]が入ってるものとします 【★2】は【E〜AI列の固定】だとします 【★3】のとおり、高速化は外しています。 **-------------------------------------------------------------------** Sub さんぷる_いち() Dim MyRNG As Range Dim 表範囲 As Range Dim MyColor As Range '着色:休日セルに着色 Dim MyKei As Range '罫線:日曜右セルに設置
With ActiveSheet.Range("E1:AI90") With .Rows("5:90") Set 表範囲 = .Cells .Borders(xlInsideVertical).Weight = xlHairline '極細 .Interior.ColorIndex = 0 '無色 End With
'▼セルの日付が日曜日だったら「MyKei」に追加 For Each MyRNG In .Rows(5).Cells If Weekday(MyRNG.Value) = vbSunday Then If MyKei Is Nothing Then Set MyKei = MyRNG Else Set MyKei = Union(MyKei, MyRNG) End If End If Next
'▼セルの値がTRUEだったら「MyColor」に追加 For Each MyRNG In .Rows(1).Cells If MyRNG.Value Then If MyColor Is Nothing Then Set MyColor = MyRNG Else Set MyColor = Union(MyColor, MyRNG) End If End If Next
'▼書式の設定 If Not MyKei Is Nothing Then Intersect(MyKei.EntireColumn, 表範囲).Borders(xlEdgeRight).Weight = xlThin '細 End If
If Not MyColor Is Nothing Then Intersect(MyColor.EntireColumn, 表範囲).Interior.Color = RGB(255, 167, 255) 'うすめピンク End If
End With
End Sub **-------------------------------------------------------------------** Sub さんぷる_にー() Dim MyRNG As Range Dim 表範囲 As Range Dim MyColor As Range '着色:休日セルに着色 Dim MyKei As Range '罫線:日曜右セルに設置
With ActiveSheet.Range("E1:E90").Resize(, 31) '中略(「さんぷる_いち」と一緒 ) End With
End Sub **-------------------------------------------------------------------** Sub さんぷる_さん() Dim i As Long Dim MyColor As Range '着色:休日セルに着色 Dim MyKei As Range '罫線:日曜右セルに設置
With ActiveSheet With .Range("E5:AI90") .Borders(xlInsideVertical).Weight = xlHairline '極細 .Interior.ColorIndex = 0 '無色 End With
For i = 5 To 5 + 30
'▼セルの値(日付)が日曜日だったら「MyKei」に追加 If Weekday(.Cells(5, i).Value) = vbSunday Then If MyKei Is Nothing Then Set MyKei = .Cells(5, i) Else Set MyKei = Union(MyKei, .Cells(5, i)) End If End If
'▼セルの値がTRUEだったら「MyColor」に追加 If .Cells(1, i).Value Then If MyColor Is Nothing Then Set MyColor = Cells(1, i) Else Set MyColor = Union(MyColor, Cells(1, i)) End If End If Next i
'▼書式の設定 If Not MyKei Is Nothing Then Intersect(MyKei.EntireColumn, .Range("E5:AI90")).Borders(xlEdgeRight).Weight = xlThin '細 End If
If Not MyColor Is Nothing Then Intersect(MyColor.EntireColumn, .Range("E5:AI90")).Interior.Color = RGB(255, 167, 255) 'うすめピンク End If
End With
End Sub
(もこな2) 2019/06/30(日) 13:10
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.