Results of 1 - 1 of about 13159 for 日付 (0.003 sec.)
- [[20130325160906]]
- #score: 2423
- @digest: 6f6681f38cca3dcd58357bdd30c8ed1c
- @id: 61881
- @mdate: 2013-04-02T04:26:52Z
- @size: 19465
- @type: text/plain
- #keywords: 日td (46493), 日di (39749), dt2 (32691), dt1 (32613), getinfo (31175), 力日 (30017), 付di (21048), entirerow (17138), クif (16303), トif (12146), fd (11601), 月31 (10736), td (9413), れ様 (7534), 土日 (7033), お疲 (6945), isdate (6809), interior (5803), 疲れ (5065), enableevents (4887), 月1 (4043), 日付 (4016), かチ (3978), color (3118), ぶら (2873), intersect (2725), range (2697), リア (2695), clearcontents (2624), セッ (2370), value (2119), と) (2118)
- 『セルに日付を入力すると入力された日に★マークが表示される』（sonson）
E1に1月1日〜NE1に12月31日と入力してあります。 D3に日付を入力するとD3に入力された日付にあたる3列目に★マークが表示されるようにしたいのですが、教えてください。 3/26 3/27 3/28 3/29 3/30 3/31 4/1 4/2 4/3 開催日 （D3に日付を入力→)4/1 ★ 開催案内 1ヶ月前 3/2 開催案内 1週間前 3/25 Excel2010 ---- すなおに、 E3 : =IF($D3=E$1,"★","") で、これをNE3までフィルコピーして、そのまま下に必要なだけフィルコピー ? (ぶらっと) ---- >>ぶらっとさん ありがとうございます。 でも回答して頂いた内容だと、全てのセルに条件文を入力しなければなりません。 それに複数行必要なので、処理自体が重くなります。 VBAとかでできないでしょうか? ---- >VBAとかでできないでしょうか? うん、そのほうがいいと思う。 シートモジュール（シートタブを右クリック、コードの表示で、でてくるところ）に以下を貼り付け。 なお、E1からNE1 まで、連続した日付がセットされているということを前提。 （とびとびの日付、たとえば1/1 の右が1/10とか、がセットされているということなら、すこしコードを直すけど） Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range Dim c As Range Dim fd As Date Dim td As Date Set r = Intersect(Target, Range("D3", Range("D" & Rows.Count).End(xlUp))) If r Is Nothing Then Exit Sub Application.EnableEvents = False fd = Range("E1").Value td = Range("NE1").Value For Each c In r c.EntireRow.Range("E1:NE1").ClearContents If IsDate(c.Value) Then If c.Value >= fd And c.Value <= td Then c.EntireRow.Cells(c.Value - fd + 5).Value = "★" End If End If Next Application.EnableEvents = True End Sub (ぶらっと) ---- >>ぶらっとさん おはようございます。 教えていただいた通りに行ったところ、正常に動作しました。 ありがとうございます。 ついでと言ったらなんですが、 日を変更した際、既に書かれている★を削除する方法もご教授ねがえないでしょうか? よろしくお願い致します。 ---- >日を変更した際、既に書かれている★を削除する方法もご教授ねがえないでしょうか? ん? そうしているつもりだけど? そうなっていない、前のものが残ったままということ? (ぶらっと) ---- >>ぶらっとさん お疲れ様です。 F3に1/1 〜 FN3に12/31 D6に日付を入力に変更しました。 前回教えて頂いた内容で、分かる範囲を修正して実行してみました。 日付を変更しても前回の★マークが残ったままです。 修正後 ↓ Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range ' <-- 入力日付 Dim c As Range ' <-- Dim fd As Date ' <--1月1日 Dim td As Date ' <--12月31日 Set r = Intersect(Target, Range("D6", Range("D" & Rows.Count).End(xlUp))) ' <-- 入力日付をセット If r Is Nothing Then Exit Sub Application.EnableEvents = False fd = Range("F3").Value ' <-- 1月1日 td = Range("NF3").Value ' <-- 12月31日 For Each c In r ' <--入力日になるまで繰り返す c.EntireRow.Range("F3:NF3").ClearContents ' <--クリア If IsDate(c.Value) Then ' <--日付が正しいかチェック If c.Value >= fd And c.Value <= td Then ' <-- c.EntireRow.Cells(c.Value - fd + 6).Value = "★" ' <-- End If End If Next Application.EnableEvents = True End Sub ---- なるほど。 元のコードで c.EntireRow.Range("E1:NE1").ClearContents こういうところがあったわけだね。で、E〜NE を F〜NF に変更したので、ここを修正。この目のつけどころは正解。 ただ、↑のコードをよくみてほしいんだけど、どの行であろうとも、"E1:NE1" 、つまりいつも「1行目??」 ちょっとわかりにくいかもしれないけど、たとえば F1 というと、我々は、エクセルシートの6番目の列の1行目のセルだと そう認識するね。でも、本当は、「シートのセル全体の中の」 F1 ということで、「」の中が省略されている。 なので、F1 というのは 「指定された領域の」1行目の6列目。 c.EntireRow という領域は、入力があった D列のセルの行全体。 その行全体.F1 が、その行のF列。 その行全体.F3 だと、その行から2行下の行のF列ということになってしまう。 なので c.EntireRow.Range("F3:NF3").ClearContents ' <--クリア ではなく c.EntireRow.Range("F1:NF1").ClearContents ' <--クリア (ぶらっと) ---- >>ぶらっとさん 迅速なご回答、ありがとうございます。 ご指摘の通り、修正したところ、クリアされました。 大変助かりました。 本当にありがとうございました。 m(_ _)m 更に追加になるのですが、 入力日を(10個位の)複数設定も可能でしょうか? 欲張りなことばかりで申し訳ありません。 ---- >入力日を(10個位の)複数設定も可能でしょうか? 今のコードですでに、D6より下のD列であれば、どこに入っても（D1000000 に入っても）処理するようになっているけど? 「複数設定」というのがよくわからないんだけど? 追記） もしかして、D列の1つのセルに 4/1,4/10,4/30 といったように入れたいということ? できないことはないけど、この場合、【年】がなくなってしまうので、実行時のシステム日付の年という扱いになるね。 で、そうであれば、それより、D列〜M列あたりを日付入力欄にして、（だから F列以降は、うんと右にシフト） 対応したほうがすっきりするけどね。 (ぶらっと) ---- To ぶらっとさん お疲れ様です。 確認しました。 素晴らしい作りです! この度は、本当に勉強になりました。 ありがとうございました。 m(_ _)m ---- To ぶらっとさん お疲れ様です。 度々申し訳ありません。 D6に入力した日付を削除すると★マークは消えるのですが、 D7に入力した日付を削除しても★マークは消えません。 何か手立てはありますでしょうか? おんぶに抱っこばかりで申し訳ありません。 ---- To ぶらっとさん お疲れ様です。 私の環境が不安定なだけでした。 お騒がせしました。 ありがとうございました。 m(_ _)m ---- ↑ いやぁ、コードのチョンボだと思うよ? 以下、メモってる間に、そちらのレスがはいったけど、そのままアップするね。 指摘深謝!! なぁるほど。チョンボだね。 日付の入力は、D列6行目以降ならどこでも対応。 クリアも下のほうに何か値があれば対応するんだけど、唯一、クリアしたD列のセルが、D列の最後の場合は 対象外とみなされてしまう。おそまつ。ペコリ! Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range ' <-- 入力日付 Dim c As Range ' <-- Dim fd As Date ' <--1月1日 Dim td As Date ' <--12月31日 Set r = Intersect(Target, Columns("D")) ' <-- 入力日付をセット If r Is Nothing Then Exit Sub Application.EnableEvents = False fd = Range("F3").Value ' <-- 1月1日 td = Range("NF3").Value ' <-- 12月31日 For Each c In r ' <--入力日になるまで繰り返す If c.Row >= 6 Then c.EntireRow.Range("F1:NF1").ClearContents ' <--クリア If IsDate(c.Value) Then ' <--日付が正しいかチェック If c.Value >= fd And c.Value <= td Then c.EntireRow.Cells(c.Value - fd + 6).Value = "★" End If End If End If Next Application.EnableEvents = True End Sub (ぶらっと) ---- To ぶらっとさん お疲れ様です。 ご対応、ありがとうございます。 問題なく動作しました。 ありがとうございました。* 100 m(_ _)m ---- To ぶらっとさん お疲れ様です。 発展系を教えてください。 D3に4/1を入力すると★マークが表示され、 D4に4/3を入力すると◎マークが表示されるように したいのですが、教えて頂けないでしょうか? よろしくお願い致します。 3/28 3/29 3/30 3/31 4/1 4/2 4/3 D3に4/1 D4に4/3 ★ ◎ ---- ん? D4 に入力したものの ◎ を 3行目にセット? それとも、素直に、D4 の場合は、4行目の該当のところに ◎ ? 後者だとしたら、5行目は? △ ? 6行目は ? (ぶらっと) ---- To ぶらっとさん 誤記です。 D3に4/1を入力 ★表示 E3に4/3を入力します。 ◎表示 3行目の列に それぞれ、★と◎が表示されるようにしたいのですが… ---- 対象の列数が多ければループで回す手もあるけど、D列とE列、2つだけなので以下のようなべたべたのコードのほうが わかりやすいかな? Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range ' <-- 入力日付 Dim c As Range ' <-- Dim fd As Date ' <--1月1日 Dim td As Date ' <--12月31日 Dim dt1 As Variant Dim dt2 As Variant Set r = Intersect(Target, Columns("D:E")) ' <-- 入力日付をセット If r Is Nothing Then Exit Sub Application.EnableEvents = False fd = Range("F3").Value ' <-- 1月1日 td = Range("NF3").Value ' <-- 12月31日 For Each c In r.Rows ' <--入力日になるまで繰り返す If c.Row >= 6 Then c.EntireRow.Range("F1:NF1").ClearContents ' <--クリア dt1 = c.EntireRow.Range("D1").Value dt2 = c.EntireRow.Range("E1").Value If IsDate(dt1) Then ' <--日付が正しいかチェック If dt1 >= fd And dt1 <= td Then c.EntireRow.Cells(dt1 - fd + 6).Value = "★" End If End If If IsDate(dt2) Then ' <--日付が正しいかチェック If dt2 >= fd And dt2 <= td Then c.EntireRow.Cells(dt2 - fd + 6).Value = "◎" End If End If End If Next Application.EnableEvents = True End Sub (ぶらっと) ---- To ぶらっとさん おはようございます。 ご教授頂いたソースを利用したのですが、動きませんでした。 条件は、下記の通りです。 F2:1/1〜NF2:12/31 D3:4/10を入力 D3:4/11を入力 ご多忙とは存じますが、ご教授願えないでしょうか。 ---- いわれてみれば、日付入力が D3 と、「3行目」なので、従来の 「N3:NF3」の日付欄は、少なくとも 3行目ではないんだね? （でも、レイアウト変更したということを書いてくれると、スムーズだったんだけどね） Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range ' <-- 入力日付 Dim c As Range ' <-- Dim fd As Date ' <--1月1日 Dim td As Date ' <--12月31日 Dim dt1 As Variant Dim dt2 As Variant Set r = Intersect(Target, Columns("D:E")) ' <-- 入力日付をセット If r Is Nothing Then Exit Sub Application.EnableEvents = False fd = Range("F2").Value ' <-- 1月1日 '■変更 td = Range("NF2").Value ' <-- 12月31日 '■変更 For Each c In r.Rows ' <--入力日になるまで繰り返す If c.Row >= 3 Then '■変更 c.EntireRow.Range("F1:NF1").ClearContents ' <--クリア dt1 = c.EntireRow.Range("D1").Value dt2 = c.EntireRow.Range("E1").Value If IsDate(dt1) Then ' <--日付が正しいかチェック If dt1 >= fd And dt1 <= td Then c.EntireRow.Cells(dt1 - fd + 6).Value = "★" End If End If If IsDate(dt2) Then ' <--日付が正しいかチェック If dt2 >= fd And dt2 <= td Then c.EntireRow.Cells(dt2 - fd + 6).Value = "◎" End If End If End If Next Application.EnableEvents = True End Sub (ぶらっと) ---- To ぶらっとさん お疲れ様です。 説明不足が多々あり、申し訳ありませんでした。 正常動作しました。 VBAの超初心者の私には、難しいです。 本当にありがとうございました。 m(_ _)m ---- To ぶらっとさん お疲れ様です。 追加で教えてください。 ★マークを記載したセルを塗りつぶしたいのですが、 上手くいきません。 ご教授願えないでしょうか。 ---- テストはしていないけど c.EntireRow.Range("F1:NF1").ClearContents ' <--クリア この下に c.EntireRow.Range("F1:NF1").Interior.ColorIndex = xlNone また、 c.EntireRow.Cells(dt1 - fd + 6).Value = "★" この下に c.EntireRow.Cells(dt1 - fd + 6).Interior.Color = vbYellow 追記） ◎ のところにも色を塗るなら、◎のところのコードの下にも c.EntireRow.Cells(dt2 - fd + 6).).Interior.Color = vbCyan とか。 (ぶらっと) ---- To ぶらっとさん お疲れ様です。 迅速なご回答、ありがとうございます。 正常動作しました。 ただ、土日の塗りつぶしもクリアされてしまい、 土日の塗りつぶしを元に戻す方法もありますか? ご多忙とは存じますが、ご教授願えないでしょうか。 ---- >ただ、土日の塗りつぶしもクリアされてしまい う〜ん、これは要件追加とか発展型といったものじゃなく、条件の後出し。 >土日の塗りつぶしを元に戻す方法もありますか? そういう方法もあるし、背景色のクリアから土日を除くという方法もあるし、いかようにもできるけど たとえばD列やE列に、（間違い入力も含めて）土日の日付がはいったら、その該当セルには色をつける? それとも、土日色のままにしておく? 色をつけるとしたら、いったん色がついて、また日付がなおされたら その前に、土日のところについていた色を消した上で、土日色に戻す? というか、D列やE列に土日の日付が入ったらエラーにしたほうがいいのかな? 土日の色を消さないということに前に、そのあたりをどうするか、考えて、教えてくれる? (ぶらっと) ---- To ぶらっとさん お疲れ様です。 確かに、ぶらっとさんのおっしゃる通り、D列やE列に土日の日付が入ったらエラーにしたほうがいいですね。 ---- ↑のコメントを読む前にメモしてアップして衝突。 そのまま以下に。 エラーにはしないで、平気で（?）土曜日や日曜日のところに色を塗る。 で、しまった、ということで、日付を直したら、間違って塗られた土曜日や日曜日のところは、元の色にもどる。 （元の色というか、2行目の日付行に塗られているそれぞれの色に戻す） とりあえず試してみて。 なお、前提として2行目の日付行にも、土、日 それぞれのセルに、それぞれの色がついているということにしている。 （少なくとも、最初の土曜日と最初の日曜には色を付けておいてね） シートモジュールのコードをすべてリプレース。 Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range ' <-- 入力日付 Dim c As Range ' <-- Dim fd As Date ' <--1月1日 Dim td As Date ' <--12月31日 Dim dt1 As Variant Dim dt2 As Variant Dim satColor As Long Dim sunColor As Long Dim satR As Range Dim sunR As Range Set r = Intersect(Target, Columns("D:E")) ' <-- 入力日付をセット If r Is Nothing Then Exit Sub Application.EnableEvents = False GetInfo Range("F2:NF2"), fd, td, satR, satColor, vbSaturday GetInfo Range("F2:NF2"), fd, td, sunR, sunColor, vbSunday fd = Range("F2").Value ' <-- 1月1日 td = Range("NF2").Value ' <-- 12月31日 For Each c In r.Rows ' <--入力日になるまで繰り返す If c.Row >= 3 Then c.EntireRow.Range("F1:NF1").ClearContents ' <--クリア c.EntireRow.Range("F1:NF1").Interior.ColorIndex = xlNone '土日の色を復元 Intersect(c.EntireRow.Range("A1:NF1"), satR).Interior.Color = satColor Intersect(c.EntireRow.Range("A1:NF1"), sunR).Interior.Color = sunColor dt1 = c.EntireRow.Range("D1").Value dt2 = c.EntireRow.Range("E1").Value If IsDate(dt1) Then ' <--日付が正しいかチェック If dt1 >= fd And dt1 <= td Then c.EntireRow.Cells(dt1 - fd + 6).Value = "★" c.EntireRow.Cells(dt1 - fd + 6).Interior.Color = vbYellow End If End If If IsDate(dt2) Then ' <--日付が正しいかチェック If dt2 >= fd And dt2 <= td Then c.EntireRow.Cells(dt2 - fd + 6).Value = "◎" c.EntireRow.Cells(dt2 - fd + 6).Interior.Color = vbCyan End If End If End If Next Application.EnableEvents = True End Sub Private Sub GetInfo(r As Range, fd As Date, td As Date, dayR As Range, dayColor As Long, func As VbDayOfWeek) Dim c As Range Dim fCol As Long Dim tCol As Long Dim x As Long Dim i As Long fd = r.Cells(1).Value td = r.Cells(r.Count).Value fCol = r.Cells(1).Column tCol = r.Cells(r.Count).Column x = ((func + 7) - Weekday(fd)) Mod 7 dayColor = r.Cells(1).Offset(, x).Interior.Color Set dayR = Nothing For i = fCol To tCol Step 7 If dayR Is Nothing Then Set dayR = Columns(i + x) Else Set dayR = Union(dayR, Columns(i + x)) End If Next End Sub (ぶらっと) ---- ↑ fd = Range("F2").Value ' <-- 1月1日 td = Range("NF2").Value ' <-- 12月31日 この2行は、いらなくなったんだけど、消し忘れで、そのままアップしてしまった。 （あっても害にはならないけど、fd や td は GetInfo の中でセットするようにしているので） (ぶらっと) ---- To ぶらっとさん お疲れ様です。 土日の塗りつぶしは消され無くなりました。 でも本日の塗りつぶしが消されちゃいます… ---- >でも本日の塗りつぶしが消されちゃいます… ん?? 本日の塗りつぶしって何のこと? まだ、聞いていない色塗りが、他にもあるのかな? そのほかにも、記念日に色がついているのは消したくないとか、祝祭日があるとか??? (ぶらっと) ---- 気を取り直し、想像をたくましくして。（これが最後になったらいいなぁ。。。） 土日に限らず、2行目の日付欄にあらかじめ塗ってある色（何種類の色が登場してもOK）を、入力行の該当列に反映。 なので、最初の土日だけじゃなく、F2〜NF2 まで、必要なセルには、必ず、それぞれに適した色が塗られていること。 (会社の創立記念日で休みの日とか、この仕事をしない日とか、好きなように） シートモジュール全てリバイス。（GetInfo プロシジャは廃止） Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range ' <-- 入力日付 Dim c As Range ' <-- Dim fd As Date ' <--1月1日 Dim td As Date ' <--12月31日 Dim dt1 As Variant Dim dt2 As Variant Dim colorV() As Long Dim k As Long Dim i As Long Set r = Intersect(Target, Columns("D:E")) ' <-- 入力日付をセット If r Is Nothing Then Exit Sub Application.EnableEvents = False fd = Range("F2").Value ' <-- 1月1日 td = Range("NF2").Value ' <-- 12月31日 With Range("F2:NF2") ReDim colorV(1 To .Columns.Count, 1 To 2) For Each c In .Cells If c.Interior.ColorIndex <> xlNone Then k = k + 1 colorV(k, 1) = c.Column colorV(k, 2) = c.Interior.Color End If Next End With For Each c In r.Rows ' <--入力日になるまで繰り返す If c.Row >= 3 Then c.EntireRow.Range("F1:NF1").ClearContents ' <--クリア c.EntireRow.Range("F1:NF1").Interior.ColorIndex = xlNone 'あらかじめ塗られていた列の色を復元 For i = 1 To k c.EntireRow.Columns(colorV(i, 1)).Interior.Color = colorV(i, 2) Next dt1 = c.EntireRow.Range("D1").Value dt2 = c.EntireRow.Range("E1").Value If IsDate(dt1) Then ' <--日付が正しいかチェック If dt1 >= fd And dt1 <= td Then c.EntireRow.Cells(dt1 - fd + 6).Value = "★" c.EntireRow.Cells(dt1 - fd + 6).Interior.Color = vbYellow End If End If If IsDate(dt2) Then ' <--日付が正しいかチェック If dt2 >= fd And dt2 <= td Then c.EntireRow.Cells(dt2 - fd + 6).Value = "◎" c.EntireRow.Cells(dt2 - fd + 6).Interior.Color = vbCyan End If End If End If Next Application.EnableEvents = True End Sub (ぶらっと) ---- To ぶらっとさん お疲れ様です。 迅速なご回答、ありがとうございます。 正常動作しました。... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201303/20130325160906.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97012 documents and 608132 words.
訪問者：