ジメジメする梅雨のお悩み、一挙解決! >>

いつも大変お世話になっております。
VBAによる月間カレンダーの作成についてVBAにお詳しい方のご教示をお願い致します。

添付画像の月間カレンダーをVBAで作成したいと思っております。
作成したいプログラムの構成を下記に記述させていただきます。

B5セルはE2セルと=で結ばれ、月間カレンダーの初日が始まりH5セルで折り返し、下に4セル降りたB10セルからH10セルまで入力を月末の日付まで繰り返し出力。
翌月は表示しない。
28日、29日、30日の月はそれに対応し罫線を引きまう。
B4セルにはE2セルの開始月からの曜日をH4まで出力。
また土曜日は青、日曜日は赤色を設定。
最後に各日付の下の4セルの中は結合し画像の様に罫線の処理をしたいプログラムになります。
以上が私の構築したいVBAプログラムになります。

誠に厚かましいお願いになりますが、どうかよろしくお願い致します。

「VBAによる月間カレンダーの作成について」の質問画像

A 回答 (2件)

こんにちは



>VBAの勉強なので~~
とのことなので、丸投げ的に作ってもらっても勉強にならないでしょう。
コードは人によって、考え方によって千差万別なので、回答されたコードが良いとは限りませんし、それが唯一の解決方法というわけでもありません。
まずは自分で作成してみて、うまくいかないところや調べてもわからないところについて質問なさったほうが、ご自身の向上に結び付くと思います。

>どの様な構成になるのかを知りたいので~~
上にも述べたように、考え方次第で構成は変わりますし、コードも別物になります。
同じ考え方であっても、人によって実際のコードは変わります。

また、エクセルの場合は、エクセルが持っている機能をどこまで利用するかによってもコードは大きく変わってきます。
例えば、日付は1、2、3・・・の文字(数値)を入れておくのか、日付型で実際の日付を入れて、セルの書式で日付のみ表示するようにするかとか、曜日の表示等についても同様ですね。その書式設定は、事前にセットしておくのかVBAで書式もセットするのかなど。
さらには、曜日の色付けやセルの枠線なども、エクセルの条件付き書式でやれば簡単ですが、VBAで直接設定することも可能です。
これらによっても、作成するコードの内容は変わってきますね。


例として、ご提示の図で日付の数値を表示する部分だけ考えてみると…
セルには日付型の数値を記入するものと仮定します。

考え方はいろいろあると思いますが、大きく分けて2通りの例を。
1)セル範囲でループする
 For rw = 5 To 20 Step 5
  For cl = 2 To 8
   'セルに日付を記入する処理
  Next cl
 Next rw
のような構文で、順に日付を設定して行く考え方。
途中で、日付がその月を超えたらブランクを記入します。

2)1日から順に記入して行く考えかた
 Do While tmpDay <= endDay
  'セルに日付を記入する処理
 Loop
のようなループで記入してゆく方法ですが、日付からセルの位置を計算する必要があるでしょう。

この他にも、考え方はいろいろあると思いますが、この2つだけでも作成されるコードは別の物になります。
1)の例
d = Range("E2").Value
tmpDay = DateSerial(Year(d), Month(d), 1)
endDay = DateSerial(Year(d), Month(d) + 1, 0)

For rw = 5 To 25 Step 5
 For cl = 2 To 8
  If tmpDay <= endDay Then
   Cells(rw, cl).Value = tmpDay
  Else
   Cells(rw, cl).Value = ""
  End If
  tmpDay = tmpDay + 1
 Next cl
Next rw

2)の例
d = Range("E2").Value
tmpDay = DateSerial(Year(d), Month(d), 1)
endDay = DateSerial(Year(d), Month(d) + 1, 0)
Set r = Range("B5")

Do While tmpDay <= endDay
 r.Value = tmpDay
 If Day(tmpDay) Mod 7 = 0 Then Set r = r.Offset(5, -6) Else Set r = r.Offset(, 1)
 tmpDay = tmpDay + 1
Loop

なお、2)のコードでは月末までしかループしていませんので、事前に全体をクリアしておくなどの処理が必要になります。
(ループ範囲を変えて、1)のように処理する方法もあるでしょう)
また、1)と2)では、記入するセルの指定方法の考え方もあえて変えています。

ご質問の内容ですと、実際には、1日~28日までの表示は固定でもよいので、先に(単純な数値型で)1~28を記入しておいて、5段目だけ処理すれば十分という考え方もできます。


※ ANo1様のご指摘にもありますが、普通のカレンダーは曜日が固定(「日月火・・・」または「月火水・・・」)なのが一般的な表示方法だと思いますので、そのような表示にするのが良さそうに思いますが・・・?
    • good
    • 0
この回答へのお礼

fujillin様二通りのプログラムコードありがとうございます。
参考に致します。
考え方次第で構成は変わり、コードも別物になるんですね。
自分の考えで少しずつプログラムを記述して行き勉強して行こうと思います。
ありがとうございました。

お礼日時:2017/06/20 03:08

B5は必ず1日になるということでいいでしょうか?


であれば、ほぼほぼVBAを使わなくてもできそうです。
VBAの勉強ということなら別ですが。。。

1日から28日はVBAではなく数字固定で大丈夫ですよね。
工夫が必要なのは29日~31日、ここは式で開始日から29日足して月が替わるかどうかで"29"を出力させるかどうかを決める、以降30日、31日も同様。
罫線は条件付き書式で日付が表示されてたら罫線を引くようにしてあればできそう。

曜日は、1日から7日までの曜日を文字列で出力し同じく条件付き書式で土曜日を青、日曜日を赤にすれば。
B2~C2までは書式でだせるので、E2に必ず1日を指定すれば。

VBAの勉強ということであれば、逆に曜日を固定して、1日をその曜日から開始するようなものを目指されたらいかがでしょうか?
    • good
    • 1
この回答へのお礼

genjitutouhi様回答ありがとうございます。
VBAの勉強なのでこの場合のカレンダー作成になりますと、どの様な構成になるのかを知りたいので他の回答者様の回答を待ってみます。
ありがとうございました。

お礼日時:2017/06/19 05:29

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

QEXCEL VBAとワークシート関数の混同は邪道なのでしょうか?

前任者が作成したEXCELファイルがあります。

VBAとユーザーフォームを作成して、ACCESSのようにまったくEXCELを知らない人でもルーティン作業ができるようになっています。
ただACCESSと違って、それを修正するのが大変です。
項目が1列又は1行増えるだけで、修正する箇所が何箇所も出てきます。

そこで少し作り変えようと思っているのですが、VBAと関数の混同は良くないのでしょうか?
① Application.WorksheetFunction.sum ではなく、
② シート作業列にSUM関数を入れる
②の場合では、他のモジュールやフォームからも参照できます。
又、変更するたびに①を実行させる必要もありません。

VBAとシート上の関数の混同は不都合はあるのでしょうか?
教えて下さい。

Aベストアンサー

「VBAとワークシート関数の混同は邪道」ではないと思います。

ただ次の点を注意する必要があるかと思います。

1.一番大きいのは「処理速度」です。
 ・セルに計算式を設定されていると、EXCELはセルに値を設定するごとに【再計算】が行われしまうことが、処理速度が大幅に低下
  することがあります。
  そのため、プログラムを実行する場合【自動計算】を一時的にストップさせています。
   Application.Calculation = xlManual
   ※処理完了後は「Application.Calculation = xlAutomatic」にします。
 ・ただ注意しないといけないのは「計算を手動」にした場合、関数で計算した値をプログラムで参照したい場合【再計算が必要】かも
  知れません。そのときは一時的に再計算をした方が間違いないかと思います。
   Range("B12").Calculate  … 特定セルだけ再計算
   Worksheets(1).Calculate  … 特定シートだけ再計算
   Application.Calculate    … 開いているすべてのブックを再計算

2.処理ロジック
  上記1.のように「再計算」を都度行う必要がある場合、漏れなく(ミス無く)対応が必要です。
  そのため、過去のプログラムを修正する場合はミスが無いようにしっかりとプログラム内容を理解することが求められます。
  ※しっかりテストすれば良いのかも知れませんが…

3.セルにプログラムで毎回計算式を設定するのなら…
 もしプログラムでセルに毎回計算式を設定するのなら「Application.WorksheetFunction」で計算した方が良いかも知れません。
 初めから計算式を設定するのなら「ユーザに式を触らせないようにシート保護」した方が良いかと思います。
 その場合、プログラムでセルに値を設定する場合、セルに書き込みできるように「シートの保護解除」等が必要になります。

◆VBAとワークシート関数の混同は邪道ではないですが、色々な問題点を意識して、プログラムを作成しないと思わぬ所で
 落とし穴があるかも知れませんので注意が必要ですね。

色々と大変だと思いますが頑張ってください。

「VBAとワークシート関数の混同は邪道」ではないと思います。

ただ次の点を注意する必要があるかと思います。

1.一番大きいのは「処理速度」です。
 ・セルに計算式を設定されていると、EXCELはセルに値を設定するごとに【再計算】が行われしまうことが、処理速度が大幅に低下
  することがあります。
  そのため、プログラムを実行する場合【自動計算】を一時的にストップさせています。
   Application.Calculation = xlManual
   ※処理完了後は「Application.Calculation = xlAutomatic」にしま...続きを読む

QVBA IF文でORを使ったとき後ろの条件が実行されない

下記VBAは特定の行だけ取り出すために組んだマクロの一部ですが、
なぜか.Value Like "W*"の部分が実行されません、
ORの前と後ろを逆にするとやはり前だけしか実行されません。

どこが問題なのでしょうか?
また、"J*"か"W*"以外の行を削除するという文はどう書くのでしょうか?

よろしくお願いします。


For j = Range("A1").End(xlDown).Row To 2 Step -1
With Cells(j, "AB")

If Not .Value Like "J*" Or .Value Like "W*" Then
.EntireRow.Delete
End If

End With

Next j

Aベストアンサー

>If Not .Value Like "J*" Or .Value Like "W*" Then
["J*"か"W*"以外の行を削除する]

これは、排他的論理積の内容ですね。
英米人は、何の問題もなく答えられるけれども、日本人などは、どうしても戸惑ってしまいます。英語には、こういう表現がありますが、日本語には、そういう表現があっても、言葉には正確に表す論理がありません。もし、本格的なプログラミングをおやりになるなら、是非、学ばれたほうがよいです。ベン図を書いて試してみるとよいです。

["J*"*か*"W*"以外の行を削除する]
「か=or(和)」が否定になると「and(積)」に変わると覚えていればよいです。

If Not (UCase(.Value) Like "J*" Or Not UCase(.Value) Like "W*" Then
または
If Not UCase(.Value) Like "J*" And Not UCase(.Value) Like "W*" Then

このように演算子が変わります。

QVBA コンパイルエラーの解消法

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示のため実行ができません。
ご指摘、よろしくお願いいたします。

Sub kopipe1() '施工体制台帳
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sb As Long
Dim m As Long
Dim p As Long
Dim c As Long
Dim i As Long
Dim end1 As Long

Set sh = Worksheet("sheet1")
Set sh1 = Worksheet("施工体制台帳 (下請け) ")


end1 = sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
sb = 1
p = 1

For i = 2 To end1 Step 1
sb = sb + 1
c = cell(p, 9)

sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
sh.cell(sb, 3).Copy Destination:=.sh1.Range(c).Offset(2, 27) '代表者名
sh.cell(sb, 4).Copy Destination:=.sh1.Range(c).Offset(4, 1) '郵便番号
sh.cell(sb, 5).Copy Destination:=.sh1.Range(c).Offset(5, 1) '住所
sh.cell(sb, 6).Copy Destination:=.sh1.Range(c).Offset(6, 24) '電話番号
sh.cell(sb, 7).Copy Destination:=.sh1.Range(c).Offset(13) '業種1
sh.cell(sb, 8).Copy Destination:=.sh1.Range(c).Offset(14, 12) '許可者1
sh.cell(sb, 9).Copy Destination:=.sh1.Range(c).Offset(14, 15) '区分1
sh.cell(sb, 10).Copy Destination:=.sh1.Range(c).Offset(14, 17) '許可1-1
sh.cell(sb, 11).Copy Destination:=.sh1.Range(c).Offset(14, 20) '許可1-2
sh.cell(sb, 12).Copy Destination:=.sh1.Range(c).Offset(14, 27) '許可年月日
sh.cell(sb, 13).Copy Destination:=.sh1.Range(c).Offset(16) '業種2
sh.cell(sb, 14).Copy Destination:=.sh1.Range(c).Offset(17, 12) '許可者2
sh.cell(sb, 15).Copy Destination:=.sh1.Range(c).Offset(17, 15) '区分2
sh.cell(sb, 16).Copy Destination:=.sh1.Range(c).Offset(17, 17) '許可2-1
sh.cell(sb, 17).Copy Destination:=.sh1.Range(c).Offset(17, 20) '許可2-2
sh.cell(sb, 18).Copy Destination:=.sh1.Range(c).Offset(17, 27) '許可年月日2
sh.cell(sb, 19).Copy Destination:=.sh1.Range(c).Offset(21, 28) '健康保険
sh.cell(sb, 20).Copy Destination:=.sh1.Range(c).Offset(22, 28) '厚生年金保険
sh.cell(sb, 21).Copy Destination:=.sh1.Range(c).Offset(23, 28) '雇用保険
sh.cell(sb, 22).Copy Destination:=.sh1.Range(c).Offset(25, 3) '現場代理人指名
sh.cell(sb, 23).Copy Destination:=.sh1.Range(c).Offset(29, 7) '主任技術者氏名
sh.cell(sb, 24).Copy Destination:=.sh1.Range(c).Offset(31, 3) '資格内容
sh.cell(sb, 25).Copy Destination:=.sh1.Range(c).Offset(33, 3) '安全衛生責任者
sh.cell(sb, 26).Copy Destination:=.sh1.Range(c).Offset(25, 26) '安全衛生推進者
sh.cell(sb, 27).Copy Destination:=.sh1.Range(c).Offset(27, 26) '雇用管理責任者
sh.cell(sb, 28).Copy Destination:=.sh1.Range(c).Offset(29, 26) '専門技術者名
sh.cell(sb, 29).Copy Destination:=.sh1.Range(c).Offset(31, 26) '技術資格内容

p = p + 62
Exit For
Next i
End Sub

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示...続きを読む

Aベストアンサー

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
とりあえず、Cells と sh1 のコンマは取るけれども、
sh1.Range(c).Offset(2, 1) これでは可読性を落とすばかりで分かりません。

これ自体を直すよりは、最初から作り直したほうが早そうです。
たぶん、一覧で横に並んでいるものを、別のシートの各場所に振り替えていくわけで、それが、ページごとになっているというわけでしょう。

まず、 sh1.cells(sb, 2).Copy ですが、
その列の2 を変数にすべきですね。

受ける側が、Offset で書かれてしまうと、手がつけられなくなってしまいます。

sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")

このようにまとめてしまい、以下のように纏めたものから呼び出すようにします。
しかし、実際にやってみると不具合が生じるので、それを配列で渡すようにします。

注:以下は、私の想像で書かれたものであって、実際に合っているのかは分かりません。
このようなスタイルにしてみたらという、あくでもこちらの提案です。

'//
Sub Test1()
 Dim Rng As Range
 Dim i As Long, j As Long, sb As Long
 Dim c As Variant
 Dim sh As Worksheet, sh1 As Worksheet
 Set sh = Worksheets("sheet1")
 Set sh1 = Worksheets("施工体制台帳 (下請け)")

 
 Set Rng = sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")
 
 end1 = sh.Cells(Rows.Count, 2).End(xlUp).row
 
 i = 2
 sb = 2
 For j = 1 To end1
 a = (j - 1) * 62 + 1
  For Each c In Rng.Offset((j - 1) * 62 + 1)
   c.Value = sh.Cells(sb, i).Value
   DoEvents
   i = i + 1
  Next
  i = 2
  sb = sb + 1
 Next
End Sub

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).C...続きを読む

Q【エクセル】最終行までコピーするマクロ

マクロ初心者です。

下記のマクロを実行するためにはどうしたらいいでしょうか。
--------------------------
A B C D E F G
1 2 2 3 4 4 5
1 
1
1
1

▼▼▼▼▼▼▼▼▼▼▼▼
A B C D E F G
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
--------------------------
今躓いている現状
A B C D E F G
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
  2 2 3 4 4 5
  2 2 3 4 4 5
  2 2 3 4 4 5
  2 2 3 4 4 5
  ・ ・ ・ ・ ・ ・
  ・ ・ ・ ・ ・ ・
  ・ ・ ・ ・ ・ ・
--------------------------


行に関してはその時々によって変わります。
よろしくお願いいたします。

マクロ初心者です。

下記のマクロを実行するためにはどうしたらいいでしょうか。
--------------------------
A B C D E F G
1 2 2 3 4 4 5
1 
1
1
1

▼▼▼▼▼▼▼▼▼▼▼▼
A B C D E F G
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
--------------------------
今躓いている現状
A B C D E F G
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
  2 2 3 4 4 5
...続きを読む

Aベストアンサー

お礼を見て:

>ちなみにコレをB~Gでそれぞれ言葉を変えたいときはどこを変更すれば良いでしょうか?

全ては書いてませんけど。

Sub try()
Dim r As Range

Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))

' Offset(行,列)で書き込みたい所を決めます。
' 行に変更はないのでOffset(,列)と行を省略できます。
' ただし列毎に代入したい値が変わるので、列数分書かないと
' なりませんけどね

' 例えばB列の場合Offset(,1) A列から見て右に+1 となり

r.Offset(, 1).Value = "あああ"

' G列の場合 A列から見て右に+6 となり

r.Offset(, 6).Value = "かかか"

' と、Offsetの列数を変更する事で書き込みたい位置を変えます
' ちなみに0だと同じ列。-1だと左に変わっていきます。
' 今回はA列を基準にしてますのでマイナスはアウトですけど。
' 行はプラスが下方向、0は同じ行、マイナスは上方向です。

Set r = Nothing

End Sub

こんな感じになりますかね。

お礼を見て:

>ちなみにコレをB~Gでそれぞれ言葉を変えたいときはどこを変更すれば良いでしょうか?

全ては書いてませんけど。

Sub try()
Dim r As Range

Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))

' Offset(行,列)で書き込みたい所を決めます。
' 行に変更はないのでOffset(,列)と行を省略できます。
' ただし列毎に代入したい値が変わるので、列数分書かないと
' なりませんけどね

' 例えばB列の場合Offset(,1) A列から見て右に+1 となり

r.Offset(, 1).Value = "あああ"

' G列の場合...続きを読む

Qマクロで消去したいです

たびたび同じ質問をしてしまい申し訳ありません
以前教えてもらった
Sub Sample()

Dim c As Range, cbx As Object
Dim rw As Long
Dim t As Single, h As Single, w As Single
Dim y As Single, v As Boolean, f As Boolean

For rw = 6 To 15
Set c = Cells(rw, 1)
t = c.Top
h = t + c.Height
w = c.Width
f = False

' Form Control
For Each cbx In ActiveSheet.CheckBoxes
y = cbx.Top + cbx.Height / 2
If t < y And y < h And cbx.Left < w Then
f = True
If cbx.Value = xlOn Then v = True Else v = False
Exit For
End If
Next cbx

' ActiveX Control
If Not f Then
For Each cbx In ActiveSheet.OLEObjects
If TypeName(cbx.Object) = "CheckBox" Then
y = cbx.Top + cbx.Height / 2
If t < y And y < h And cbx.Left < w Then
f = True
v = cbx.Object.Value
Exit For
End If
End If
Next cbx
End If

If f And v Then
Cells(rw, 3).Resize(, 3).ClearContents
Cells(rw, 16).Resize(, 2).ClearContents
End If
Next rw

End Sub
でシート「操作画面」のC13:E13,P13:Q13 C15:E15,P15:Q15は消去することができました
それを応用して別シート「集計」のI7:I12 K7:K12も合わせて消去しようかと思ったのですが上手く
動作しませんでした

大変申し訳ないのですが、また、ご指導のほどよろしくお願いいたします

たびたび同じ質問をしてしまい申し訳ありません
以前教えてもらった
Sub Sample()

Dim c As Range, cbx As Object
Dim rw As Long
Dim t As Single, h As Single, w As Single
Dim y As Single, v As Boolean, f As Boolean

For rw = 6 To 15
Set c = Cells(rw, 1)
t = c.Top
h = t + c.Height
w = c.Width
f = False

' Form Control
For Each cbx In ActiveSheet.CheckBoxes
y = cbx.Top + cbx.Height / 2
If t < y And y < h And cbx.Left < w Then
f ...続きを読む

Aベストアンサー

前回回答者です。

最初に、前回の説明と重複になってしまいますが・・・
https://oshiete.goo.ne.jp/qa/9807697.html

説明にもありますように、通常はセルとチェックボックスの関係をきちんと取れるようにしておいてから、マクロを作成するものと思います。
その意味において、前回のNo1様、No3様の回答は関係性を確かなものにする方法を提示なさっています。

No2の回答は、それらの情報が与えられないので、しかたなく見た目から推測する方法で処理したものですので、正確性や効率性の点であまり良いものとは言えません。
また、チェックボックスも複数の種類が想定でき、どちらなのかが不明でしたので、両方を考慮しましたが、実際には(常識的に)どちらか一方だけの利用であると推測できますので、結果的に残り半分のコードは不要ということになります。
さらに、きちんと関係性が取れている場合は、位置関係から探す必要もなくなるので、コードも大幅に短くできるはずですが、不明な状況でしたので、ひとまず冗長なコードであっても提示しておけば、後は、質問者様がアレンジなさるであろうことを期待しての回答でした。


今回のご質問で、
・それを応用して~~
・〇〇も合わせて消去しようかと~
・上手く動作しませんでした
「応用する」、「うまく動作しない」という情報だけから推理しようとしても、あまりにも可能性が広がりすぎてしまって皆目見当がつきません。

多少なりともヒントになりそうな情報として記せそうなのは、前回の回答で「セルの内容を消去している」部分は
> Cells(rw, 3).Resize(, 3).ClearContents
> Cells(rw, 16).Resize(, 2).ClearContents
の2行である、ということぐらいでしょうか。
(この部分に関しては、前回のNo3様と、たまたま同様の記述になっています)
ANo3様のコードの方が、シートを明記する形式で対象を指定していますので、より明確な記述方法になっていると言えるかもしれません。

ちなみに
>別シート「集計」のI7:I12 K7:K12を消去する
という部分だけであれば、
 Worksheets("集計").Range("I7:I12,K7:K12").ClearContents
のような記述で実現できるはずと思います。

前回回答者です。

最初に、前回の説明と重複になってしまいますが・・・
https://oshiete.goo.ne.jp/qa/9807697.html

説明にもありますように、通常はセルとチェックボックスの関係をきちんと取れるようにしておいてから、マクロを作成するものと思います。
その意味において、前回のNo1様、No3様の回答は関係性を確かなものにする方法を提示なさっています。

No2の回答は、それらの情報が与えられないので、しかたなく見た目から推測する方法で処理したものですので、正確性や効率性の点であまり良いものとは...続きを読む

Qエクセル VBA 条件を複数指定したいのですが。。

Dim buf As Single
With sh1
For i = 6 To 200 'Sheet1の6行目から200行目まで'
If InStr(Range("F" & i), "空室,") > 0 Then
buf = buf + Range("K" & i)
End If

Next i

Range("J200") = "使用量"
Range("J201") = "空室等"
Range("J202") = "合計"
Range("K202").Formula = "=SUM(K3:K197)" '合計
Range("K201") = buf '空室等
Range("K200") = Range("K202") - Range("K201") '控除
For i = 1 To 3
Range("K" & i).NumberFormatLocal = "0.0"

Next i

三点、質問させていただきます。

1、空室 という文字が含まれる行の数値を合計させるために上記のようにしています。そこに、”共用部”や”管理外”など、条件の単語を追加したいのですが、
”空室,共用部,管理外” ではダメなんですね、、
どのように記述すれば、複数の単語を対象に出来ますか?
それとも、行をコピーしておのおの指定するべきでしょうか?

2、6行目から200行目 ではなく、「6行目から下方向、データがある行まで」
というような、指定は出来ますでしょうか??

3、マクロ実行後、セルの数値を手で打ち変えた際に、合計の値も連動して変わるようにするには、bufを使わないでやればいいのでしょうか?

'Range("AK243").Formula = "=SUM(AL3:AL239)" '空室合計計算
'Range("AK244").Formula = "=SUM(AK3:AK239)" '合計計算
'Range("AK242") = Range("AK244") - Range("AK243") '差引合計計算

上記の行を使うと、後でセルの数値を変更した場合連動して合計値なども変わってくれるのですが・・

添削をお願いできませんでしょうか。。
宜しくお願いいたします。

Dim buf As Single
With sh1
For i = 6 To 200 'Sheet1の6行目から200行目まで'
If InStr(Range("F" & i), "空室,") > 0 Then
buf = buf + Range("K" & i)
End If

Next i

Range("J200") = "使用量"
Range("J201") = "空室等"
Range("J202") = "合計"
Range("K202").Formula = "=SUM(K3:K197)" '合計
Range("K201") = buf '空室等
Range("K200") = Range("K202") - Range("K201") '控除
For i = 1 To 3
Range("K" & i).NumberFormatLocal ...続きを読む

Aベストアンサー

1.以下のように変えてください。
If InStr(Range("F" & i), "空室,") > 0 Or InStr(Range("F" & i), "共用部,") > 0 Or InStr(Range("F" & i), "管理外,") > 0 Then

2.Sheet1の最大行をもとめておき、そこまで行うようにします。
Dim maxrow as Long
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row '・・・・①
として
For i = 6 To maxrow
・・・・
next i
とします。
尚、①は、最大行を持つ列がAの場合です。もし、他の列が最大行を持っているならその列を指定して下さい。

3.
>マクロ実行後、セルの数値を手で打ち変えた際に、合計の値も連動して変わるようにするには、bufを使わないでやればいいのでしょうか?
>上記の行を使うと、後でセルの数値を変更した場合連動して合計値なども変わってくれるのですが・・
質問の意味がよくわかりませんが、上記の行を使ってうまく行くならそれを使用すればよいと思います。

1.以下のように変えてください。
If InStr(Range("F" & i), "空室,") > 0 Or InStr(Range("F" & i), "共用部,") > 0 Or InStr(Range("F" & i), "管理外,") > 0 Then

2.Sheet1の最大行をもとめておき、そこまで行うようにします。
Dim maxrow as Long
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row '・・・・①
として
For i = 6 To maxrow
・・・・
next i
とします。
尚、①は、最大行を持つ列がAの場合です。もし、他の列が最大行を持っているならその列を指定して下さい。

3.
>マクロ実行後、セ...続きを読む

Q過去にVBAでの「シフト表の何日~何日までの求め方」を相談したものです

このVBAのプログラムの表に月の始まりから終わりまで罫線を引きたいのですが罫線の列と行を指定する為にはFor i = 0 To (e_date - s_date)とDim maxrow1 As Longを使用すればよろしいのでしょうか?

色々と調べsh1.Range(sh1.Cells(), sh1.Cells(maxrow1 + 1, e_date - s_date)).Borders.LineStyle = True
と、このプログラムを使えばよろしいのでしょうか?

どなたか分かる方、ご教示をよろしくお願い致します。

Aベストアンサー

こんにちは

ご提示のコードはプログラム全体のうちのごく断片です。
そこに示される変数の意味や、実際に実行されているときの内容(値)がどうなっているのかは、断片を見ただけでわかる人はいません。
それなので、良いとも悪いとも回答はできないでしょう。
(変数の意味や内容は、そのコードの作者が自由に決めていますので、変数名だけ見ても何もわかりません)

仮に変数の内容がわかったとしても、対象としているエクセルの表がどのような状態なのかもわかりませんので、何をどう処理しているのか、その処理が適切なのかといったことも判断はできません。
>このVBAのプログラムの表に~~
「このVBAのプログラム」が何かが提示されていないので、内容がわかりませんね。


・・などと言っているだけでは回答になりませんので、一般的にわかる範囲で…
>For i = 0 To (e_date - s_date)
For~~Nextの間の処理を繰り返す構文です。
何回繰り返すかというと、i=0から始めて1、2・・・の順で、i=(e_date - s_date)になるまで繰り返します。

>Dim maxrow1 As Long
maxrow1という変数を長整数型の数値として使用しますという宣言です。
長整数型とは、-2,147,483,648 ~ 2,147,483,647の範囲の整数を表せるデータ型の一種です。

>sh1.Range(sh1.Cells(), sh1.Cells(maxrow1 + 1, e_date - s_date)).Borders.LineStyle = True
指定範囲のセルの罫線を指定する構文ではありますが、いくつかおかしな点があります。
セル範囲を指定する最初の値が、sh1.Cells()となっていますが、これではセル全体を示してしまうので、意味的におかしなことになっています。
LineStyle属性にTrueを設定していますが、通常は「XlLineStyle列挙」の中の値を指定します。
https://msdn.microsoft.com/ja-jp/library/office/ff821622.aspx
Trueを数値化すると、エクセルでは-1となりますので、普通はこのような指定はしないはずですが…?

・・・という程度のことまではご質問文から判断できますが、それ以上は無理です。
前回の作者様が回答なさってくだされば、もう少しは意味のある回答になるものと思いますけれど。

こんにちは

ご提示のコードはプログラム全体のうちのごく断片です。
そこに示される変数の意味や、実際に実行されているときの内容(値)がどうなっているのかは、断片を見ただけでわかる人はいません。
それなので、良いとも悪いとも回答はできないでしょう。
(変数の意味や内容は、そのコードの作者が自由に決めていますので、変数名だけ見ても何もわかりません)

仮に変数の内容がわかったとしても、対象としているエクセルの表がどのような状態なのかもわかりませんので、何をどう処理しているのか、その処...続きを読む

QシフトJISのCSVファイルをUFT-8(BOMなし)のCSVに変換したい

素人ですが、職場で必要に迫られ模索中です。
ご教授お願いします。

ユーザ情報.csvというシフトJISのファイルを、同じフォルダで同一名のファイル、ユーザ情報.csv(UFT-8(BOMなし)に変換するバッチファイルを作成したいです。
バッチが不可能であればVBスクリプト?(まったくわからないけど)でも結構です。

最終的にはタスクスケジューラに仕込んで毎日定時に、チェックしてシフトJISであった場合、変換をするという動作が理想ですが、とりあえず変換するバッチが作れないので話になりません(;;

敷居が高いかもしれませんが、ファイルがUTF-8であってもエラーとならないように作れるとチェックして云々は不要と思っています。

よろしくお願いします(><

Aベストアンサー

#4の回答者です。

nkf でも、Wscript でも、UTF-8 BOMなし変換は出来ましたが、

Wscript 側は、かなり面倒です、といっても、書いた本人が言うだけで、コピー&ペーストーするだけの話ですが。

結局、#2さんの言う通りになってしまいましたね。(^^;

>ユーザ情報.csvというシフトJISのファイルを、同じフォルダで同一名のファイル、ユーザ情報.csv(UFT-8(BOMなし)に変換するバッチファイルを作成したいです。

これだけで良いのでは?
-----------------------
Rem to_utf8.bat
@echo off
nkf.exe -w --overwrite %1
echo on
-----------------------SJISで保存すること----
戻すオプションは、 -s です。(sjis) %1の所はファイル名でも可

nkf.exe のありか。
http://www.vector.co.jp/soft/win95/util/se295331.html

》Copyright (C) 1987, FUJITSU LTD. (I.Ichikawa).
》Copyright (C) 1996-2010, The nkf Project.

富士通がクレジットしているとは知りませんでしたね。

#4の回答者です。

nkf でも、Wscript でも、UTF-8 BOMなし変換は出来ましたが、

Wscript 側は、かなり面倒です、といっても、書いた本人が言うだけで、コピー&ペーストーするだけの話ですが。

結局、#2さんの言う通りになってしまいましたね。(^^;

>ユーザ情報.csvというシフトJISのファイルを、同じフォルダで同一名のファイル、ユーザ情報.csv(UFT-8(BOMなし)に変換するバッチファイルを作成したいです。

これだけで良いのでは?
-----------------------
Rem to_utf8.bat
@echo off
nkf.exe -w --ove...続きを読む

QVBAの最終行を求めるプログラムを指定範囲にするプログラム

お世話になっております。
Excelの表でE2セルからE30セルまでデータが入力されており、そのセルの最終行を求めるプログラムをmaxrow=Cells(Rows.Count, "E").End(xlUp).row
としておりました。
しかしE31セルから下に異なるデータを入力する事になり、上記のプログラムですと上書きして出力してしまう問題が起こる為、セルの範囲をE2セルからE30セルまでに指定する方法をご教示いただきたい内容になります。

よろしくお願い致します。

Aベストアンサー

単純にmaxrow=Cells(30, "E").End(xlUp).rowでよいと思います。

この時にE1からE30まで空っぽの場合、maxrowは1を返します。
2-maxrowが0より大きければ、範囲内は空っぽだと判断できると思います。

QVBAでのファイル名と更新日(作成日)の抽出

VBAにてあるフォルダにあるすべてのPDFファイル名と更新日(作成日)の抽出をしたいです。
A1セルに抽出するフォルダパス名が入っています。

A3セルより下(A3,A4,A5~)にファイル名
B3セルより下(B3,B4,B5~)に更新日(作成日)

を表示させたいです。

ご教示願います。

Aベストアンサー

こんばんは。
本日、共有フォルダ(一部無線LANでの中継アリ)でいくつかテストしたのですが直接セルに取得した値を入力していくとかなり遅くなるようですね。

そこで、自分のPCのCドライブ直下に作業用のテキストファイルをつくり、そこにフォルダ内のファイルと更新日時をフィルタリングせずにずらっと書き込み。
それをExcelで、不要ファイルは無視しつつセルに入力していく、、という手法にしてみました。

ここでいう不要ファイルはMacから共有フォルダに書き込んだ際に出来ることがある、”.”で始まる隠しファイルの事です。

ちなみに、820個のファイルがある共有フォルダで、ワークテキスト作成が約20秒、それをExcelのセルに入力するのが「ほんの一瞬」です。
ファイルのなら並びはおそらくファイル名の昇順となっているようですが、そういったソート方法の変更もExcelに読み込んだのちに処理したほうが良いと思います。
ソート範囲の指定は、コードにもありますが、Range("A3", Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))というようなレコード数によって可変となるようにすれば大丈夫だと思います。

作業用テキストファイルは、該当するファイルが無い場合は新規で作りますし、既存の場合は、前回分はクリアされたうえで書き込まれます。
ファイルの設定場所は自分のPC上で権限ある場所ならどこでも構いません。

また、タブ区切りのテキストしているので、作業用テキストファイルを開いて全選択してコピー、A3セルをクリックした状態でペーストしても(不要ファイル除去を除いては)同じ結果が得られます。

ギリギリ現実な速度かなと思いますが、一度試されてみてください。


----以下 ソース---


Sub Pdflistup()

FolderPath = Range("A1").Value: 'セルA1にフォルダーのパスがあるということなので。
WText = "C:\WorkText.txt": '作業用テキストファイル

'該当フォルダにあるファイルの名称と更新日時を作業用テキストファイルに書き込む

Set FileSys = CreateObject("Scripting.FileSystemObject")
Set FileObj = FileSys.GetFolder(FolderPath).Files
Set WorkText = FileSys.CreateTextFile(WText, True)

For Each PdfObj In FileObj

With PdfObj

WorkText.WriteLine (.Name & Chr(9) & .DateLastModified): '名称(タブ)更新日時の形で書き込み

End With

Next

WorkText.Close

Set FileSys = Nothing

'作業用テキストファイル作成処理完了


'セルの値をクリア(A3~Bの最終行まで)

Range("A3", Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)).Clear


'WorkText.txtを開き、一行ずつセルに入力(ファイル名はA3から、更新日時はB3から)

Open WText For Input As #1

n = 3: '入力開始行

Do Until EOF(1)

Line Input #1, Tline

Tvalue = Split(Tline, Chr(9)): 'テキストをタブで分割(一次配列格納)

If Not Left(Tvalue(0), 1) = "." Then

Cells(n, 1).Value = Tvalue(0): 'n行A列にファイル名を入力
Cells(n, 2).Value = Tvalue(1): 'n行B列に更新日を入力
n = n + 1
End If
Loop

Close #1


'セル書き込み作業完了

MsgBox ("処理が完了しました。")


End Sub

こんばんは。
本日、共有フォルダ(一部無線LANでの中継アリ)でいくつかテストしたのですが直接セルに取得した値を入力していくとかなり遅くなるようですね。

そこで、自分のPCのCドライブ直下に作業用のテキストファイルをつくり、そこにフォルダ内のファイルと更新日時をフィルタリングせずにずらっと書き込み。
それをExcelで、不要ファイルは無視しつつセルに入力していく、、という手法にしてみました。

ここでいう不要ファイルはMacから共有フォルダに書き込んだ際に出来ることがある、”.”で始まる隠しフ...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報