Excel VBA質問箱 IV

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

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


4114 / 13646 ツリー ←次へ | 前へ→

【58370】年間カレンダーで、祝日にマルをつけたい たねこ 08/10/21(火) 18:53 質問[未読]
【58373】Re:年間カレンダーで、祝日にマルをつけたい neptune 08/10/21(火) 22:09 発言[未読]
【58381】Re:年間カレンダーで、祝日にマルをつけたい たねこ 08/10/22(水) 19:27 発言[未読]
【58383】Re:年間カレンダーで、祝日にマルをつけたい neptune 08/10/22(水) 21:31 発言[未読]

【58370】年間カレンダーで、祝日にマルをつけたい
質問  たねこ  - 08/10/21(火) 18:53 -

引用なし
パスワード
   はじめまして。
excelで、A4サイズの年間カレンダーを作っています。
(余白なし、セル縦30横30の日付のみのカレンダー)
理想は、年号セル(2008)を変えるだけで、
全てが正しく変更されるカレンダーです。

カレンダーの日付を関数で正確に出したり、
土日のセルの背景色を変えたり、土日祝の文字色を変えたり、
ということは、関数や、条件付き書式で表現できたのですが、
祝日にマルをつける、という段階になって、
どうやらVBAでないとダメらしい、と気づいて、勉強を始めました。
(この時点で、カレンダーは年号セルで変更、
後にボタンを押せば、上からばーっとマルがつく、
という形にしようと考えました)

ネットを検索しながらポチポチと打ち込んでみたものの、
どうしてもエラーが出て形になりません。
1つの日付セルに対して、祝日リストを参照して当たりか
どうか調べる、当たっていたら、セルにマルをつける、
という形で考えていたのですが…。


もしよろしければ、この処理を使えばいいよーみたいな助言を
していただけると、勉強の道しるべになります。
よろしくお願いします。
excelは2007を使っております。

以下、作ったマクロです。変だと思いますがご一考ください。


'マクロの名前です。
Sub 祝日マル付け()

'まず、色々な数字を定義づけします。
Dim karenda As Range 'カレンダー12か月分のセル
Dim syukujitu As Range '祝日のリストのこと

Dim atari As Variant 'カレンダーと祝日表の照合用
Dim idou As Variant

Dim hidari As Integer 'マル付け用
Dim ue As Integer 'マル付け用

'楕円のオートシェイプを、現在アクティブなシートから完全消去します。
ActiveSheet.Ovals.Delete

'次に、カレンダーのデータをマクロに読み込みます。
With ActiveSheet
Set karenda = .Range("=$B$5:$H$10,$J$5:$P$10,……以下、12か月分つづく。")
End With

'次に、祝日の日付(年月日)をマクロに読み込みます。
'祝日は、同じシート内で、振替も含めた式を算出して、日付を出しています。
With ActiveSheet
Set syukujitu = .Range("$AB$3:$BA$17")
End With

'ここからやりたい処理の開始です。
'祝日のデータを見て、カレンダーの中から該当する日付を検索します。

For Each idou In karenda
idou = karenda.Select
  For Each atari In karenda
  atari = Application.IsNumber(Application.Match(karenda, syukujitu, 0))
    If atari = True Then
      '以下、円を書くためのマクロです。23は、円の大きさです。
      hidari = ActiveCell.Left '書き始め、セルの左
      ue = ActiveCell.Top '書き始め、セルの上
      With ActiveSheet.Shapes.AddShape(msoShapeOval, hidari, ue, 23, 23)
      .Fill.Transparency = 1 '塗りつぶしなし
        With .Line '円のラインに関する各種設定をします。
        .DashStyle = msoLineSolid
        .Style = msoLineSingle
        .Visible = msoTrue
        .Weight = 0.75
        .ForeColor.SchemeColor = 8
        End With
      End With
    End If
  Next atari
Next idou


'終わります。
End Sub

【58373】Re:年間カレンダーで、祝日にマルをつけ...
発言  neptune  - 08/10/21(火) 22:09 -

引用なし
パスワード
   ▼たねこ さん:
こんにちは

え〜と、2007は持ってないので回答はできませんが、
>ネットを検索しながらポチポチと打ち込んでみたものの、
>どうしてもエラーが出て形になりません。
せめて、どこでどのようなエラーが発生するか、を説明しないと
回答が付きにくいと思いますよ。
人の書いたプログラムって読むの結構面倒ですから。

>1つの日付セルに対して、祝日リストを参照して当たりか
>どうか調べる、当たっていたら、セルにマルをつける、
>という形で考えていたのですが…。
1つの日付セルってのが気になりますが、1つの日付(年月日)に対して判断を
するってのは正攻法でよいと思います。

どのカレンダーも手法はいろいろあると思いますが、基本的な処理としては
そうしているはずです。

【58381】Re:年間カレンダーで、祝日にマルをつけ...
発言  たねこ  - 08/10/22(水) 19:27 -

引用なし
パスワード
   ▼neptune さん:
>▼たねこ さん:
>こんにちは

こんにちは、たねこと申します。
お返事ありがとうございます。

>
>え〜と、2007は持ってないので回答はできませんが、
>>ネットを検索しながらポチポチと打ち込んでみたものの、
>>どうしてもエラーが出て形になりません。
>せめて、どこでどのようなエラーが発生するか、を説明しないと
>回答が付きにくいと思いますよ。
>人の書いたプログラムって読むの結構面倒ですから。
>

内容をきちんと書く必要がありましたね。
すみません、うかつでした。

処理としては、マクロを実行すると、
そもそもisnumber(match)の関数が、正常に動作しません。
全てfalse(祝日該当なし)になってしまいます。

仮に、祝日以外をすべてマルにしなさい、とtrue部分をfalseに
書き換えてマクロを実行してみても、
左上のセル(最初に日付判定を始めるセル)の上で、
延々とマルが書かれ続けます。アクティブセルの移動は全然起こりません。

と、こんな感じです。エラーと言っても、マクロ自体が止まって
エラー表示が出るわけではありませんでした。
重ね重ね、説明足らずでごめんなさい。

>>1つの日付セルに対して、祝日リストを参照して当たりか
>>どうか調べる、当たっていたら、セルにマルをつける、
>>という形で考えていたのですが…。
>1つの日付セルってのが気になりますが、1つの日付(年月日)に対して判断を
>するってのは正攻法でよいと思います。
>
>どのカレンダーも手法はいろいろあると思いますが、基本的な処理としては
>そうしているはずです。
ありがとうございます。
基本的なマクロの作り方の路線は、大丈夫とのこと、
逆走していないと分かっただけでも嬉しいです。
ありがとうございます。

【58383】Re:年間カレンダーで、祝日にマルをつけ...
発言  neptune  - 08/10/22(水) 21:31 -

引用なし
パスワード
   ▼たねこ さん:
こんにちは

それでは
>そもそもisnumber(match)の関数が、正常に動作しません。
>全てfalse(祝日該当なし)になってしまいます。
検索の一例(サンプル)だけ。

'シートの祝祭日データを辞書に入れてしまうサンプル
private dic as object

Private Sub SetDic()
  Set dic = CreateObject("scripting.dictionary")
  '日付をKey、祝祭日名をItemにして辞書作成
  dic.Add Format(Date, "yyyy/mm/dd"), "今日"
  dic.Add Format(Date + 1, "yyyy/mm/dd"), "明日"
  dic.Add Format(Date + 2, "yyyy/mm/dd"), "明後日"
End Sub

'日付から祝祭日をチェックする
'祝祭日なら祝祭日名、無い時は""を返す
Public Function SeachHoliday(pDate As Date) As String
Dim sRet As String
Dim sFind As String
  
  If dic Is Nothing Then Call SetDic
  
  sRet = ""
  sFind = Format(pDate, "yyyy/mm/dd")
  
  If dic.Exists(sFind) Then '存在する場合
    sRet = dic(sFind)
  End If

  SeachHoliday = sRet
  
End Function

'動作テスト
Sub test()
  Debug.Print SeachHoliday(Date)
End Sub

4114 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free