VBAコードでカレンダーの表示を短くする方法

このQ&Aのポイント
  • VBAのコードでカレンダーの表示を簡略化する方法について教えてください。
  • 現在のコードでは変数の数が多く、無駄に感じます。もっとスッキリとしたコードにする方法はありますか?
  • セルの幅や高さを調整する際に、より短くなる方法を教えてください。
回答を見る
  • ベストアンサー

コードの簡略化(変数を少なくできますか?)

カレンダーの作成(4ヶ月分)で 月、曜日、月-日、Do_ITを書き出すセル幅及び高さを VBAのコードでそれぞれ指定しています。 現在、以下のコードですが いかにも変数(i2-i10)の数が多くと無駄のように思えます。 もう少し、スッキリ短く成るコードに出来ませんか ? Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer Dim i5 As Integer, i6 As Integer, i7 As Integer, i8 As Integer Dim i9 As Integer, i10 As Integer 'セル幅の調整 Columns("B:H").ColumnWidth = 10 'セルの高さ調整 (月の行) For i1 = 1 To 40 Step 13 Rows(i1).RowHeight = 14 Next 'セルの高さ調整 (曜日の行) For i2 = 2 To 41 Step 13 Rows(i2).RowHeight = 14 Next 'セルの高さ調整(月-日の行) For i3 = 3 To 11 Step 2 Rows(i3).RowHeight = 16 Next 'セルの高さ調整(月-日の行) For i4 = 16 To 24 Step 2 Rows(i4).RowHeight = 16 Next 'セルの高さ調整 (月-日の行) For i5 = 29 To 37 Step 2 Rows(i5).RowHeight = 16 Next 'セルの高さ調整 (月-日の行) For i6 = 42 To 50 Step 2 Rows(i6).RowHeight = 16 Next 'セルの高さ調整 - Do it For i7 = 4 To 12 Step 2 Rows(i7).RowHeight = 40 Next 'セルの高さ調整 - Do it For i8 = 17 To 25 Step 2 Rows(i8).RowHeight = 40 Next 'セルの高さ調整 - Do it For i9 = 30 To 38 Step 2 Rows(i9).RowHeight = 40 Next 'セルの高さ調整 - Do it For i10 = 43 To 51 Step 2 Rows(i10).RowHeight = 40 Next

質問者が選んだベストアンサー

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1617/2456)
回答No.4

For i = 1 To 40 Step 13 この時「i」には各月の先頭行(月の行)が入っていますので ↓先頭行(月の行)と次の行(曜日の行) Range(Rows(i), Rows(i + 1)).RowHeight = 14 先頭行の2行下(月-日の行)と3行下(Do i)から始まって2行おきに5回 For j = 2 To 11 Step 2 Rows(i + j).RowHeight = 16 Rows(i + j + 1).RowHeight = 40 Next Next 2 To 11は 2 To 10で良かったです。 NuboChanさんのコード For i3 = 3 To 11 Step 2 Rows(i3).RowHeight = 16 Next の所をコピペして書き替えたときに11を書き替え忘れてました。 NuboChanさんのコードを見ても 'セルの高さ調整(月-日の行)//月の行の2行下から始まる i3 = 3 i4 = 16 以下略 'セルの高さ調整 - Do it //月の行の3行下から始まる i7 = 4 i8 = 17 以下略 となっていますし、各5回ループの始まりは13行飛ばしになっています。

NuboChan
質問者

お礼

説明を受けて理解が深まり作成の手順が少しは理解できました。 コードを少し変更しました。 こちらの方が私には判りやすいです。 iiを上から順番に行幅に対応するように当てはめて行きました。 (iとjは既に、他の場所で利用しているのでiiとjjに変更しました。) For ii = 1 To 40 Step 13 '月のカレンダー開始行は、1,14,27,40 の4回 (同じ処理) Rows(ii).RowHeight = 14   ’月の行 (先頭) Rows(ii + 1).RowHeight = 14 '曜日の行 (次の行) For jj = 1 To 5 '月-日の行、Do-Itの行は、月に5回作成で2行がセット Rows(ii + 2 * jj).RowHeight = 16 Rows(ii + 2 * jj + 1).RowHeight = 40 Next Next

その他の回答 (3)

回答No.3

質問の目的が理解できません。 セル幅及び高さをVBAで指定したいとは、目的によって幅、高さを変えて作成したいということでしょうか? VBAの勉強が目的というのでなければ、Excelの基本的機能で対応したほうが良いと思うのですがいかが? セル幅の調整 1)列B~Hを選択 2)ホーム/セル/書式/列の幅 で幅を指定すれば一度に設定できる セルの高さ調整 1)幅と同様指定したい行を選択(ctrlキーを押しながら選択すれば離れた行も選択可) 2)ホーム/セル/書式/行の高さ で高さを指定すれば一度に設定できる どうしてもVBAでやってみたい場合は、No.2の方法になります。

NuboChan
質問者

補足

おっしゃるようにシートの列、行に対して 直接数値を設定して変更出来ることは理解しています。 今回の場合は、1度実行すれば 同じフォーム(カレンダー)なので毎回VBAで再設定する必要も無いことも承知しています。 自分で作成したコードに納得が行かなかったのでVBAの勉強も兼ねた相談です。 アドバイスを受けて 既にコードの簡略化ができたので個人的には満足しています。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

質問文には、したいことを(エクセルの列、行、セルなどのエクセルの用語で)文章で書いてほしい。こんな繰り返しのコードを読むのは苦痛。 一例としての 参考で ・繰り返しの利用 ・(限定のために)配列で値の列挙の利用 を勧める。 繰り返すときに変化する箇所をどう表現するか、がポイント。 Sub test01() n = 1 For Each r In Array(3, 5, 7, 9) For Each cl In Range("A" & r & ":" & "G" & r) MsgBox cl cl.Interior.ColorIndex = 6 cl.RowHeight = 22 cl.ColumnWidth = 23 n = n + 1 If n > 20 Then Exit Sub Next Next End Sub を挙げてみる。 n=1 n = n + 1 If n > 20 Then Exit Sub は テスト用で、実際は省くもの。

NuboChan
質問者

お礼

imgashiさんへ、 コードだけで読見とくのは難しいと考えて 1ヶ月分だけですコードを実行した後の画像を参考にのせています。 (4ヶ月だと画像が小さくなってしまうので1ヶ月分だけす。   画像には罫線がありますが他のコードで書いていますが。  今回の質問には、無関係なので気にしないでください。) 回答は、配列を利用したものですが初心者には難しいので kkkkkmさんの回答を先に追いかけたいと思います。

NuboChan
質問者

補足

以下、先の「お礼」が変な記事になり 読みにくいので以下のように修正させてください。 ’------------------------------------------------ imgashiさんへ、回答かんしゃします。 コードだけで読見とくのは難しいと考えて 1ヶ月分だけですがコードを実行した後の画像を参考にのせています。 (4ヶ月だと画像が小さくなってしまうので1ヶ月分だけです。   画像には罫線がありますが他のコードで書いていますので、  今回の質問には、無関係なので気にしないでください。) 回答は、配列を利用したものですが初心者には難しいので kkkkkmさんの回答を先に追いかけたいと思います。

  • kkkkkm
  • ベストアンサー率65% (1617/2456)
回答No.1

以下で試してみてください。 1か月ごとでセットして4か月分ループしてます。 Sub Test() Dim i As Long, j As Long Columns("B:H").ColumnWidth = 10 For i = 1 To 40 Step 13 Range(Rows(i), Rows(i + 1)).RowHeight = 14 For j = 2 To 11 Step 2 Rows(i + j).RowHeight = 16 Rows(i + j + 1).RowHeight = 40 Next Next End Sub

NuboChan
質問者

お礼

kkkkkmさん、今回もお世話になります。 提示いただいたテスト用のマクロと 私が作成したマクロを交換して上手く同じ処理が出来ている事を確認しました。 いただいたコードをですが、構造を読み解こうとするのですが 現在まで理解できていません。 「1か月ごとでセットして4か月分ループしてます。」 For i = 1 To 40 Step 13 - Next が4ヶ月分の4回ループ と言う事は何となく分かったのですが後は理解が及びません。 Kkkkkmさんは、どうやってこのコードに至ったのか、 もう少し解説いただけませんか?

関連するQ&A

  • マクロ 行の高さの変更を繰り返す

    2行目から134行目までの「行の高さ」を1行おきに「4」にしたいのですが 「マクロの記録ボタン」の「相対参照」で2行分を作って、繰り返してみると 結合しているセルが有るせいか、2~134行目全てが「4」になってしまいます 仕方ないので、ネットで調べて書いてみたのですが、 Sub Macro1() Dim i As Integer For i = 2 To 134 Step 2 Rows("i:i").RowHeight = 4 Next i End Sub こんな感じで作ったらエラーが出ました マクロは、かなり久しぶりなので、どう書いたらいいのか教えてやって下さいませ

  • エクセルのセル高調整で指定したセルから下を調整

    エクセルのセル高調整で指定したセルから下を調整したいのですが。エクセルVBAで下記の方法でやるとすべてのセルがFITします。やりたいことは、3行目以降のセル全体をFITさせたいのです。 どこを追記したら良いか教えて下さい。 Sub セル高調整() 'Sheets("すべて")のセルの高さの調整 Dim lrow As Integer Dim km As Long Application.ScreenUpdating = False '画面の更新を停止 ActiveSheet.Select Range("b3").CurrentRegion.Select Selection.Rows.AutoFit lrow = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row + 1 For km = 1 To lrow Rows(km).RowHeight = Rows(km).RowHeight + 10 Range("a3").Select Next km End Sub

  • 色のないセルの行削除

    任意の色で塗りつぶされたセルがあって、塗りつぶされたセルが存在する行を削除するマクロ。 Sub 行削除() Dim r As Integer Dim c As Integer For c = ActiveSheet.UsedRange.Columns.Count To 1 Step -1   For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1     If Cells(r, c).Interior.ColorIndex <> xlNone Then        Rows(r).Delete     End If   Next Next End Sub この逆のことがしたいのですが、わかりません。 ちなみにこのプログラムはそのままC&Pです。 内容もあまり理解できていません。(^_^;) 添付画像の逆に色のついた行だけ残したいです。 よろしくお願いします

  • はじめまして。

    はじめまして。 エクセル2000で以下のような一行おきに1を書く簡単なVBAを作ったのですが、 30000行までしかどうしても表示されないのですが、なぜでしょうか? 宜しければご教授ください。 Dim i As Integer For i = 1 To 60001 Step 2 Cells(i, 1).Value = 1 Next i

  • 複数のセルでの方法

    現在下記のようなマクロを組んであるのですが、これだと5列目が「0」のときの実行マクロです。 '5列目(工数)が「0」のとき該当する行の高さを「0」にする。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" Then Rows(i).RowHeight = 0 End If Next 私はこれではなくて、5列目と7列目の同じ行にあるセルに「0」がはいっていたら行の高さを「0」にしたいのです。 そこで私は If Cells(i, 5).Value = "0" Then これを If Cells(i, 5).Value = "0" And Cells(i, 7).Value = "0" Then にしたところエラーが発生しました。 良い方法があればお教えください。 よろしくお願いします。

  • エクセルマクロ配列で変数は使えますか

    エクセル2013です。 初めて配列を使います。 以下のように作成し思ったようにできました。 Sub 計算() '成功 Dim a As Integer Dim c As Integer Dim b(5) As Integer Dim 最終行 Dim 値列  値列 = 17 最終行 = Cells(Rows.Count, 1).End(xlUp).Row For 処理業 = 1 To 最終行 For a = 1 To 5 b(a - 1) = Cells(1, 値列) 値列 = 値列 + 1 Next 値列 = 17 For a = 1 To (22 - 値列) c = c + b(a - 1) Next Cells(処理業, 30) = c a = 0 c = 0 Next 処理業 End Sub ただ計算する列の範囲をインプットボックスで入力した値 にしたい為以下のように改造しました。 Dim b(対象列) As Integerでエラーになります 配列には変数は使用できないのでしょうか? よろしくお願いします。 Sub 計算() '失敗 Dim a As Integer Dim c As Integer Dim b(対象列) As Integer’★ここでERRになる Dim 最終行 Dim 対象列 Dim 値列  対象列 = 22'インプットボックスで入力した値 値列 = 17 最終行 = Cells(Rows.Count, 1).End(xlUp).Row For 処理業 = 1 To 最終行 For a = 1 To (対象列 - 17) b(a - 1) = Cells(1, 値列) 値列 = 値列 + 1 Next 値列 = 17 For a = 1 To (22 - 値列) c = c + b(a - 1) Next Cells(処理業, 30) = c a = 0 c = 0 Next 処理業 End Sub

  • VBAで行を挿入する

    VBAを始めた初心者です。 Exel2002使用です。 VBAでA列の4行目から10行目に行の挿入をできるようにしようと下記のように書きましたが、Rows("i:i").Selectの部分でデバックがかかってしまいます。間違っている理由がわからないのですがよろしくお願いします。 また、DO While Loopステートメントを使ってA列が空白になるまで(例えばA4セル以下の)行を挿入とする場合の方法も教えていただけましたら幸いです。 Sub 4行目から10行目まで() Dim i As Integer For i = 4 To 10 Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown Next i End Sub Sub 4行目から空白になるまで() Dim i As Integer Range("A4").serect Do While activecell.value = "" Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown activecell.offset(1,0).select Loop End Sub

  • EXCELVBAで行の削除

    WIN98SE EXCEL2000です。 G列に99の文字があったらその行を削除するというVBAを下記のように作りました。 Dim i As Integer Dim rowcount As Integer rowcount = Cells(1,1).CurrentRegion.Rows.Count For i = 1 To rowcount If Cells(i, 7) = "99" Then Rows(i).Delete Next i これを実行するとG列に99のある行が連続してあると1行おきに削除されます。どこをなおせばよいのか教えてください。よろしくお願いします。

  • vba boolean変数を開放する方法

    エクセルのセルに「○○○○○○○○○○××××××××××」と入っているものをランダムに並べ代えるマクロを探してみました。 Sub macro2() Dim i, m As Integer Dim b, c As String Dim flg(1 To 20) As Boolean b = Cells(1, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(1, 2).Value = c End Sub これはうまく動くのですが、10行分やろうとして、以下のように変更すると暴走(終わらない)します。 Sub macro2() Dim i, m, n As Integer Dim b, c As String Dim flg(1 To 20) As Boolean For n = 1 To 10 b = Cells(n, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(n, 2).Value = c next n End Sub 一行目が終わってもboolean変数の値がそのまま残っているのが原因らしいのですが開放する方法がわかりません。 取りあえずもう一つマクロを追加してやりたいことはできたのですが、 Sub macro1() Dim n As Integer For n = 1 To 10 Call macro2(n) Next n End Sub Sub macro2(n As Variant) 以下略 なんかスッキリしません。 boolean変数を開放し、マクロひとつですます方法を教えて頂きたくお願いします。 flg(m) = Falseを挿入してもダメでした。

  • Excel マクロ:変数を複数使う場合

    マクロ初心者です。 For文で、変数を2つ定義し、それぞれが1つずつ増えてくれるような マクロを組みたいのですが、うまくいきません。 例えばA列の並んだ数字を、B列に一個とばしで入力するとして・・・ 例) Dim i As Integer Dim j As Integer For j = 2 To 10 Step 2 For i = 1 To 9 Cells(j, 2).Value = Cells(i, 1).Value Next i, j ではだめですよね。iが1つ増える時に、jも1つ増える、 というようにVBAを組むことが可能なのでしょうか? ど素人な質問ですみませんが、教えてください。

専門家に質問してみよう