EXCELカレンダー出勤日黒色、休日赤色から1、0

質問

EXCEL会社カレンダー出勤日黒色、休日赤色があるとして
ここから出勤日1、休日0のデータマトリックスを作るマクロを教えてください
例
2014/1　0,0,0,0,0,1,1,1,1,1
2014/2 0,0,1,1,1,1,1

回答No.5

bin-chan · ベストアンサー

＃４にまたしてもミス。重ね重ねすみません。

１）以下２行を編集する（等号の右辺）
thisworkbook.worksheets("Sheet2").range("A1").offset(0, objRange.value) = "'" &objRange.value %", "
は
thisworkbook.worksheets("Sheet2").range("A1").offset(0, objRange.value) = "'" &objRange.value &", "
（最後の項の前、%　は　&　の間違い）

なんだか、全角数字で日にちを書いてる気がしてきたので改定版です

sub 変換()

　dim objRanges as range
　dim objRange as range

　dim nColor as integer

　dim nDay as integer

　set objRanges = Range(selection.address)

　for each objRange in objRanges

　　nDay=CINT(objRange.value)

　　if nDay >=1 AND nDay <= 31 then
　　　select case objRange.font.color
　　　case 255　　　'赤
　　　　ncolor = 0
　　　case else　　　'その他（黒）
　　　　ncolor = 1
　　　end select
　　　thisworkbook.worksheets("Sheet2").range("A1").offset(0, objRange.value) = "'" & objRange.value & ", "
　　　thisworkbook.worksheets("Sheet2").range("A2").offset(0, objRange.value) = "'" & nColor & ", "
　　end if
　next objRange
　set objRanges = nothing

end sub

カレンダー範囲は、手動で選択としてますが、
カレンダー範囲が固定なら
set objRanges = Range(selection.address)　行を
変更してください。

Sheet1 のセルD3～セルJ8（７列×６行）の場合なら
set objRanges = Thisworkbook.Worksheets("Sheet1").Range("D3:J8")
でもOK。
毎月Sheet1 のセルD3～セルJ8でカレンダーを作ってください。
それなら、見出しもか。
Sheet1 のセルB2に年月入力して、
Sheet2 のセルA1に式[=Sheet1!B2 & ", "]を設定すると良いかも。

補足

又エラーメッセージ型式が一致しませんが出ます
↓
nDay = CInt(objRange.Value)
デバッグしたら
objRange.Valueに大きなブランクが入っていました。

回答No.4

bin-chan

> 実行時エラー：型が一致しません
ありゃー、数字以外があるんですか。「丸付き数字」とかかな？

offset(0, objRange.value)行で、
objRange.valueが1～31の数値であるとして作成してます。

forEachの次行　
　if objRange.value <>"" then
を
　if objRange.value >=1　AND objRange.value <=31 0then
としてみてください。

CSV出力は省略してますがちょっとヒント。
１）以下２行を編集する（等号の右辺）
thisworkbook.worksheets("Sheet2").range("A1").offset(0, objRange.value) = "'" &objRange.value %", "
thisworkbook.worksheets("Sheet2").range("A2").offset(0, objRange.value) = "'" & nColor & ", "

２）Sheet2の結果範囲をメモ帳にでもコピペ
３）年月を手入力、各行末カンマ削除
４）名前を付けて保存、でファイル名前を"CALENDER.CSV"のように
　　ダブルクォーテーションで囲って保存→これで拡張子がCSVで保存できる

回答No.3

bin-chan

＃１・＃２です。転記ミスがありました。

> set objRanges = Rangeselection.address)
'カッコ開くが足りませんです。
set objRanges = Range(selection.address)

sub 変換()

　dim objRanges as range
　dim objRange as range

　dim nColor as integer

　set objRanges = Range(selection.address)

　for each objRange in objRanges

　　if objRange.value <>"" then
　　　select case objRange.font.color
　　　case 255　　　'赤
　　　　ncolor = 0
　　　case else　　　'その他（黒）
　　　　ncolor = 1
　　　end select
　　　thisworkbook.worksheets("Sheet2").range("A1").offset(0, objRange.value) = objRange.value
　　　thisworkbook.worksheets("Sheet2").range("A2").offset(0, objRange.value) = nColor
　　end if
　next objRange
　set objRanges = nothing

end sub

補足

ThisWorkbook.Worksheets("Sheet2").Range("A1").Offset(0, objRange.Value) = objRange.Value
のところで
実行時エラー：型が一致しません
のメッセージが出てしまいます
どうしたらよいでしょうか？

回答No.2

bin-chan

＃１です。超簡略版ですがご容赦ください。

以下、カレンダーのブックでAlt+F11キー押下して、標準モジュールを追加して貼り付け。
カレンダー範囲を指定して、マクロ[変換]を起動してください。

sub 変換()

'【条件】
'・Sheet1 にカレンダーがあるとしますが実はSheet2以外ならどこでも良い。
'・列方向（七曜）の６行をい想定してるが、縦一列でもOK。
'・一箇月分を囲んでください。7×6なら矩形でＯＫ。空白日付は読み飛ばします
'・当然、休日には赤で着色済としますが、環境によって色コードが異なるかも。caseを調整してください。
'・結果はSheet2のセルB1：Cxxに出ます。
'・CSV化までは最初の要件になかったのでご容赦ください。
'・年月は考えてません。手入力でも何でもご自由に。

　dim objRanges as range
　dim objRange as range

　dim nColor as integer

　set objRanges = Rangeselection.address)

　for each objRange in objRanges

　　if objRange.value <>"" then
　　　select case objRange.font.color
　　　case 255　　　'赤
　　　　ncolor = 0
　　　case else　　　'その他（黒）
　　　　ncolor = 1
　　　end select
　　　thisworkbook.worksheets("Sheet2").range("A1").offset(0, objRange.value) = objRange.value
　　　thisworkbook.worksheets("Sheet2").range("A2").offset(0, objRange.value) = nColor
　　end if
　next objRange
　set objRanges = nothing

end sub

回答No.1

bin-chan

うーん、前提条件少なすぎ。
例示データも１月分１０件・２月分７件の意味がわからない。

「色を判断して、値[0]と[1]を知りたい」ということ？

「マクロの記録」で「着色するときどのようなコードが必要か」を調べ
「全セルについてIF文で判断」じゃないですか？

補足

詳しく補足例を書きます
下記のEXCELカレンダーがあるという前提です
１月
日 月 火 水 木 金 土
*1*2 *3 *4
*5 6 7 8 9 10 11
*12*13141516 17 18
*192021 22 2324*25
*262728 29 3031
上図で*は赤文字、その他は黒文字とします
これから
2014/01 　1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1
　　　　　　25 26 27 28 29 30 31
　　　　　　0 0 1 1 1 1 1
という0と1のデータ行を作りるEXCELマクロを作りたいのです。
会社の業務システムカレンダーを作るとき0,1のCSVファイルインポートせねばならないからです