![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
No.5ベストアンサー
- 回答日時:
#4にまたしてもミス。
重ね重ねすみません。1)以下2行を編集する(等号の右辺)
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(7列×6行)の場合なら
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
- 回答日時:
> 実行時エラー:型が一致しません
ありゃー、数字以外があるんですか。「丸付き数字」とかかな?
offset(0, objRange.value)行で、
objRange.valueが1~31の数値であるとして作成してます。
forEachの次行
if objRange.value <>"" then
を
if objRange.value >=1 AND objRange.value <=31 0then
としてみてください。
CSV出力は省略してますがちょっとヒント。
1)以下2行を編集する(等号の右辺)
thisworkbook.worksheets("Sheet2").range("A1").offset(0, objRange.value) = "'" &objRange.value %", "
thisworkbook.worksheets("Sheet2").range("A2").offset(0, objRange.value) = "'" & nColor & ", "
2)Sheet2の結果範囲をメモ帳にでもコピペ
3)年月を手入力、各行末カンマ削除
4)名前を付けて保存、でファイル名前を"CALENDER.CSV"のように
ダブルクォーテーションで囲って保存→これで拡張子がCSVで保存できる
No.3
- 回答日時:
#1・#2です。
転記ミスがありました。> 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
- 回答日時:
#1です。
超簡略版ですがご容赦ください。以下、カレンダーのブックでAlt+F11キー押下して、標準モジュールを追加して貼り付け。
カレンダー範囲を指定して、マクロ[変換]を起動してください。
sub 変換()
'【条件】
'・Sheet1 にカレンダーがあるとしますが実はSheet2以外ならどこでも良い。
'・列方向(七曜)の6行をい想定してるが、縦一列でもOK。
'・一箇月分を囲んでください。7×6なら矩形でOK。空白日付は読み飛ばします
'・当然、休日には赤で着色済としますが、環境によって色コードが異なるかも。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
- 回答日時:
うーん、前提条件少なすぎ。
例示データも1月分10件・2月分7件の意味がわからない。
「色を判断して、値[0]と[1]を知りたい」ということ?
「マクロの記録」で「着色するときどのようなコードが必要か」を調べ
「全セルについてIF文で判断」じゃないですか?
この回答への補足
詳しく補足例を書きます
下記のEXCELカレンダーがあるという前提です
1月
日 月 火 水 木 金 土
*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ファイルインポートせねばならないからです
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 正社員 会社カレンダーの信憑性&夜勤について 3 2022/12/03 23:17
- Excel(エクセル) 年間仕事用シフトカレンダーに、日勤 夜勤 休み に色分けをした。 4 2022/12/09 04:12
- Excel(エクセル) 出勤簿の土、日、休日に色付けできない 2 2022/08/04 20:10
- その他(就職・転職・働き方) 土日祝休みでも5/7は仕事の人 2 2022/05/01 09:25
- 所得税 税金に詳しい方教えてください!! うちの旦那の会社なのですが、日祝は休みで土曜日は会社のカレンダー上 9 2022/07/28 14:35
- フィナンシャルプランナー(FP) 本日の日付が(F1)出たら、本日の勤務が(F2)同時に出るようにしたいのです。 1 2022/09/12 11:53
- その他(暮らし・生活・行事) どちらの旦那がいい? 年収1000万以上で激務、休日出勤や、残業が多い会社に務めるため仕事が中心 年 8 2023/08/08 04:09
- その他(悩み相談・人生相談) 工場で働いてるんですが 救出が多すぎて辛いです。 毎日残業3時間なので土日はゆっくり休みたいので。 3 2023/02/02 12:27
- 会社・職場 今、勤めている会社は週休二日制ではなく日曜は確定で休みで土曜と祝日は会社カレンダーで休みかどうか決ま 4 2023/04/20 07:56
- 健康保険 傷病手当金の申請について 3 2022/07/09 09:14
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
横にコピーするマクロを教えて...
-
【ExcelVBA】値を変更しながら...
-
Worksheets メソッドは失敗しま...
-
VBA シートをコピーする際に Co...
-
VBAマクロ実行時エラーの修正に...
-
[EXCEL]ボタン押す→時刻が表に...
-
エクセルで複数のシートのクリ...
-
「段」と「行」の違いがよくわ...
-
VBA 指定した列にある日時デー...
-
あああ..ああい..ああう とい...
-
Excel グラフのプロットからデ...
-
Excelで、あるセルの値に応じて...
-
Cellsのかっこの中はどっちが行...
-
EXCELのSheet番号って変更でき...
-
ワイルドカード「*」を使うとう...
-
Excel VBAでのWorksheet_Change...
-
VBA シート名が一致した場合の...
-
フォルダ内の全てのファイルに...
-
特定の文字がある行以外を削除...
-
IIF関数の使い方
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
横にコピーするマクロを教えて...
-
UWSCを使用して、ドロップダウ...
-
EXCELカレンダー出勤日黒色、休...
-
バイトを変換するスクリプト
-
【VBA】 IFの中にIF
-
true lifeの意味
-
強調構文について It is only a...
-
HTML ドロップダウンメニ...
-
条件に一致するデータの平均 ...
-
ホームページの資料請求フォー...
-
英文の和訳をお願い
-
excel vba
-
英→和訳助けて下さい!!!
-
Excel、変数4つの和が25になる...
-
RGBを色コードに
-
MT4 直前の足の四本値 つづき
-
この専門用語の意味は?
-
この「of」の用法、意味不明です。
-
VBAマクロ実行時エラーの修正に...
-
エクセル マクロ オートフィ...
おすすめ情報