Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
305 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【81095】適用範囲 T-K 19/10/17(木) 1:13 質問[未読]
【81096】Re:適用範囲 γ 19/10/17(木) 9:31 発言[未読]
【81098】Re:適用範囲 T-K 19/10/18(金) 1:02 質問[未読]
【81099】Re:適用範囲 γ 19/10/18(金) 17:18 発言[未読]
【81100】Re:適用範囲 T-K 19/10/19(土) 19:37 お礼[未読]
【81101】Re:適用範囲 γ 19/10/19(土) 22:23 発言[未読]
【81095】適用範囲
質問  T-K  - 19/10/17(木) 1:13 -
引用なし
パスワード
   windows10
EXCEL 2016

休日を条件付き書式で色付けしたいのですが、
シート数も多く、表の大きさも違うため、シートごとの設定が大変です。
VBAを作成しましたが、適用範囲設定で分からず
こまっています。
どなたかわかる方いらしたらおしえてください。


Sub fmcdtn()

Dim sh As Worksheet
Dim fc As FormatCondition


For Each sh In Sheets
　 sh.Cells.FormatConditions.Delete


　　 Set fc = sh.Cells.FormatConditions. _
　　 Add(xlExpression, , "=COUNTIF(祝日データ,A$2)=1")
　fc.Interior.Color = RGB(204, 255, 255)
　
　Next
　

End Sub
【81096】Re:適用範囲
発言  γ  - 19/10/17(木) 9:31 -
引用なし
パスワード
   適用範囲の特徴は無いのですか？
・特定の文字列が左上に書いてある場所から始まるとか
・CurrentRegionとOffset、InterSect等で割り出すことができるとか
そうしたことを検討してみてください。
そうした特徴を示してもらえばなんとかなるかも。

自分で見当がつかないことを、そのファイルを見たこともない、
何も情報を持っていない人に相談されても、
こうすべきだなどと即答できるわけがないですよ。
【81098】Re:適用範囲
質問  T-K  - 19/10/18(金) 1:02 -
引用なし
パスワード
   A列には商品　B列C列には商品を作るための工程　Ｅ列２行目以降には、日付が記入されていますD3以降は受注情報在庫情報になります加工情報になります
途中空白があるためcuurent.RegionはダメでしたUsedRangeがいいのかEndで
処理したほうがいいのか、試行錯誤してますが、うまくいきません
現状の状態を下記に記しましたのでどこを訂正したほうがいいのか
おしえてください
＊C列の最終行は空白でないため行数処理で使用しています
２行目は日付が入力されているため列数処理に使用しました
Sub fmcdtn()

Dim sh As Worksheet
Dim fc As FormatCondition
Dim gyou As Integer
Dim retu As Integer


gyou = Cells(Rows.Count, 3).End(xlUp).Row
retu = Cells(2, Columns.Count).End(xlToLeft).Column


　For Each sh In Sheets

　 sh.Cells.FormatConditions.Delete


　　 Set fc = sh.Range(sh.Cells(1, 1), sh.Cells(gyou, retu)).FormatConditions. _
　　 Add(xlExpression, , "=COUNTIF(祝日データ,A$2)=1")
　fc.Interior.Color = RGB(204, 255, 255)
　
　
Next

End Sub
【81099】Re:適用範囲
発言  γ  - 19/10/18(金) 17:18 -
引用なし
パスワード
   だいぶ前進しましたね。
気になるのは、特定した行番号、列番号が、
すべてのシートで同じという前提になってしまっている点でしょうか。
行、列を求めるコードを、繰り返しの中でシート毎に実行したらどうでしょう。
【81100】Re:適用範囲
お礼  T-K  - 19/10/19(土) 19:37 -
引用なし
パスワード
   教えていただいた通り作り直したら希望通り
の処理ができました本当にありがとうございました。
一応できたものを下に記入します


Sub fmcdtn()


Dim fc As FormatCondition
Dim gyou As Long
Dim retu As Long
Dim rng As Range


For i = 1 To Sheets.Count

Sheets(Sheets(i).Name).Activate


gyou = Cells(Rows.Count, 3).End(xlUp).Row
retu = Cells(1, Columns.Count).End(xlToLeft).Column


　　　 ActiveSheet.Cells.FormatConditions.Delete
　　　
　　　
　　　 Range("A1").Activate


Set rng = Range(Sheets(i).Cells(1, 1), Sheets(i).Cells(gyou, retu))

　　 Set fc = rng.FormatConditions. _
　　 Add(xlExpression, , "=COUNTIF(祝日データ,A$1)=1")
　fc.Interior.Color = RGB(204, 255, 255)　
　
gyou = 0
retu = 0


　 Next


End Sub
【81101】Re:適用範囲
発言  γ  - 19/10/19(土) 22:23 -
引用なし
パスワード
   出来上がったようで何よりです。

インデントをしっかりつけることをお薦めします。

Sub fmcdtn()
　　Dim fc As FormatCondition
　　Dim gyou As Long
　　Dim retu As Long
　　Dim rng As Range

　　For i = 1 To Sheets.Count
　　　　Sheets(Sheets(i).Name).Activate
　　　　gyou = Cells(Rows.Count, 3).End(xlUp).Row
　　　　retu = Cells(1, Columns.Count).End(xlToLeft).Column
　　　　ActiveSheet.Cells.FormatConditions.Delete
　　　　Range("A1").Activate
　　　　Set rng = Range(Sheets(i).Cells(1, 1), Sheets(i).Cells(gyou, retu))
　　　　Set fc = rng.FormatConditions. _
　　　　　　　　 Add(xlExpression, , "=COUNTIF(祝日データ,A$1)=1")
　　　　fc.Interior.Color = RGB(204, 255, 255)
　　　　gyou = 0
　　　　retu = 0
　　Next
End Sub

少し手を入れるとすると、こんな感じでしょうか。
できるだけ、シートやセルをSelectしないほうがよいかと思います。

Sub fmcdtn2()
　　Dim fc As FormatCondition
　　Dim gyou As Long
　　Dim retu As Long
　　Dim rng As Range

　　For i = 1 To Worksheets.Count
　　　　With Worksheets(i)
　　　　　　gyou = .Cells(.Rows.Count, 3).End(xlUp).Row
　　　　　　retu = .Cells(1, .Columns.Count).End(xlToLeft).Column
　　　　　　.Cells.FormatConditions.Delete
　　　　　　
　　　　　　Set rng = .Range(.Cells(1, 1), .Cells(gyou, retu))
　　　　　　Set fc = rng.FormatConditions. _
　　　　　　　　　　 Add(xlExpression, , "=COUNTIF(祝日データ,A$1)=1")
　　　　　　fc.Interior.Color = RGB(204, 255, 255)
　　　　End With
　　Next
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
305 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free