[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『横カレンダーの内容を七曜カレンダーに表示』（ぷーこ）
はじめましてよろしくお願いします。
Ａ ｜ Ｂ | Ｃ | ～～～～ ｜ ＡＦ １ ｜ | | ○月予定表 ｜ ２ 日にち ｜ １ | ２ | ～～～～ | ３１ ３ 曜日 ｜ 月 ｜ 火 | ～～～～ | 水 ―――――――――――――――――――――――――――――――――――――――――― ４ なまえ①｜ 9:00～16:30 ｜ 9:00～16:30 | ～～～～ ｜ ５ なまえ②｜ ｜ 9:00～16:30 | ～～～～ ｜9:00～16:30 ６ なまえ③｜ 9:00～16:30 ｜ | ～～～～ ｜14:00～16:30 ７ なまえ④｜ 11:00～16:00｜ 9:00～ショート| ～～～～ ｜14:00～16:30 ８ なまえ⑤｜ ｜ 13:00～16:00 | ～～～～ ｜9:00～16:30 ・ ・ ｜ ・ | ・ ｜ ・ ｜ ・ ・ ・ ｜ ・ | ・ ｜ ・ ｜ ・ ・ ・ ｜ ・ | ・ ｜ ・ ｜ ・ 30 なまえ26｜9:00～ｼｮｰﾄ ｜ ｜ ｜14:00～16:30
という横カレンダーに予定の時間を入力すると
Ａ ｜ Ｂ | Ｃ | ～～～～ ｜ Ｇ １ | | | ○月予定表 ｜ ２ 日 ｜ 月 | 火 |～～～～ | 土 ―――――――――――――――――――――――――――――――――――――――――― ３ ｜ １ ｜ ２ | ～～～～ | ６ ―――――――――――――――――――――――――――――――――――――――――― ４ ｜①くん9:00～16:30 ｜①くん9:00～16:30｜～～～～ |②さん9:00～16:30 ５ ｜③くん9:00～16:30 ｜②さん9:00～16:30|～～～～ ｜④くん9:00～16:30 ６ ｜26さん9:00～ｼｮｰﾄ ｜④くん9:00～ｼｮｰﾄ | ～～～～ ｜①くん14:00～16:30 ７ ｜④くん11:00～16:00｜⑤さん13:00～16:00|～～～～ ｜⑧さん14:00～16:30 ８ ｜ ｜ | ～～～～｜⑨くん14:00～16:30 ・ ・ ｜ ・ | ・ ｜ ・ ｜ ・ ・ ・ ｜ ・ | ・ ｜ ・ ｜ ・ ―――――――――――――――――――――――――――――――――――――――――― 14 ７ ｜ ８ | ９ | ・ ｜ １３ ―――――――――――――――――――――――――――――――――――――――――― 15 ｜③くん9:00～ｼｮｰﾄ ｜ ｜ ｜⑤さん9:00～16:30 ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ ・ 七曜カレンダーに名前と時間を表示したいのです。
横カレンダーは月が変わると曜日が変わり、七曜カレンダーは月が変わると日にちが変わるように設定したいです。 別シートのようになっていますが、できれば１枚のシートに作りたいです。（七曜カレンダーの隣に横カレンダー）
説明わかりづらいと思いますがよろしくお願いします。
こんにちは。かみちゃん です。
> 横カレンダーは月が変わると曜日が変わり、七曜カレンダーは月が変わると日にちが変わるように設定したいです。 > 別シートのようになっていますが、できれば１枚のシートに作りたいです。（七曜カレンダーの隣に横カレンダー）
VBAで処理することでも構わないでしょうか？ 七曜カレンダーは、1日分に10行しか転記できないようなのですが、それ以上あったらどうするのですか？
(かみちゃん) 2009/08/29 22:52
かみちゃん様コメントありがとうございます。
ＶＢＡでも大丈夫です。 １日の定員が１０名なので七曜カレンダーには１０行でいいのですが、実際は１１行目に別のことを書き込むので空の１行を作りたいです。 あと、名前と時間だけしか書いてなかったのですが、実は「①くん 9:00～16:30 送迎 弁」ということを入れたいです。 送迎・迎え・送り・(空欄)の４パターン 弁もある時とない時があります。 付け加えのあって面倒だと思いますが、よろしくお願いします。
(ぷーこ)
こんにちは。かみちゃん です。
> １日の定員が１０名なので七曜カレンダーには１０行でいい
1日10名を超えていたら、最初の10名分を転記するということでいいですよね？ それとも、「10名を超えています」というメッセージを出したほうがいいのでしょうか？
> 送迎・迎え・送り・(空欄)の４パターン 弁もある時とない時があります。
この情報はどこから得るのでしょうか？横カレンダーにはないですよね？
> 七曜カレンダーに名前と時間を表示したいのです。
1日の10名の順番ですが、もしかして、開始時刻（？）の早い順、同じ開始時刻であれば、終了時刻（？）の早い順、ショートの場合は、最後、つまり
①くん9:00～16:30 ③くん9:00～16:30 26さん9:00～ｼｮｰﾄ ④くん11:00～16:00
という順番にしないといけないということでしょうか？
*****
これから空いた時間で考えるので、数日お時間をいただけますでしょうか？ もちろん、他の方から書き込みがあれば、そちらを参照してくださっても結構です。
(かみちゃん) 2009/08/31 20:08 22:11追記 22:22追記
かみちゃん様
説明不足・付け足しでご面倒かけてすみません。
>1日10名を超えていたら、最初の10名分を転記するということでいいですよね？ それとも、「10名を超えています」というメッセージを出したほうがいいのでしょうか？
「10名を超えています」というメッセージが出るならそうして頂けるとありがたいです。
>この情報はどこから得るのでしょうか？横カレンダーにはないですよね？
送迎と弁の情報は横カレンダーに入れます。
>1日の10名の順番ですが、もしかして、開始時刻（？）の早い順、同じ開始時刻であれば、終了時刻（？）の早い順、ショートの場合は、最後、つまり
①くん9:00～16:30 ③くん9:00～16:30 26さん9:00～ｼｮｰﾄ ④くん11:00～16:00
という順番にしないといけないということでしょうか？
できればそのような順番になると嬉しいです。
急いではいませんので、お時間のある時に教えていただけたらありがたいです。 よろしくお願いします。
(ぷーこ)
こんにちは。かみちゃん です。
> 送迎と弁の情報は横カレンダーに入れます。
横カレンダーのどこのセルに入れるのですか？
現在以下のようなサンプルシートを作ってあります。 一見ずれて見難いですが、これをコピーして、Excelシートに「形式を選択して貼り付け」の「テキスト」をしていただくと、 セル位置が反映されます。
[A] [B] [C] [1] [2] 日にち 2009/8/1 2009/8/2 [3] 曜日 土 日 [4] 佐藤 9:00～16:30 9:00～16:30 [5] 鈴木 9:00～16:30 [6] 高橋 9:00～16:30 [7] 田中 11:00～16:00 9:00～ショート [8] 渡辺 13:00～16:00
たとえば、2009/8/1 の 佐藤 の 9:00～16:30 に 送迎や弁の情報 は、どのセルに入れるのか教えてください。 9:00～16:30 と入力してあるB4セルに "9:00～16:30送迎" という感じなのでしょうか？
(かみちゃん) 2009/09/01 7:03
かみちゃん様
>たとえば、2009/8/1 の 佐藤 の 9:00～16:30 に 送迎や弁の情報 は、どのセルに入れるのか教えてください。 9:00～16:30 と入力してあるB4セルに "9:00～16:30送迎" という感じなのでしょうか？
そうです。時間の後ろに送迎や弁の情報をいれます。"9:00～16:30 送迎 弁"のようにです。
(ぷーこ)
こんにちは。かみちゃん です。
>> 開始時刻（？）の早い順、同じ開始時刻であれば、終了時刻（？）の早い順、ショートの場合は、最後
という順番でなければいけないのであれば、
> 時間の後ろに送迎や弁の情報をいれます。"9:00～16:30 送迎 弁"
というように 終了時刻（？）16:30 の後は、半角スペースを入れていただいて、必要な情報を続けるということができますか？
(かみちゃん) 2009/09/02 10:37
こんにちは。かみちゃん です。
大変遅くなりましたが、
>> 開始時刻（？）の早い順、同じ開始時刻であれば、終了時刻（？）の早い順、ショートの場合は、最後
の順番の並べ替えはできていないのですが、転記部分は、できましたので、一旦提案させていただきます。
[A] [B] [C] [1] [2] 日にち 2009/8/1 2009/8/2 [3] 曜日 土 日 [4] 佐藤 9:00～16:30 9:00～16:30 [5] 鈴木 9:00～16:30 [6] 高橋 9:00～16:30 [7] 田中 11:00～16:00 9:00～ショート [8] 渡辺 13:00～16:00
というシートレイアウトでB2セルには、開始日を 2009/8/1 のように日付型で入力します。 C2セルには、=B2+1 D2セル～AC2セルは、C2セルをコピー AD2セルには、=IF(AC2="","",IF(MONTH(AC2+1)=MONTH($B2),AC2+1,"")) AE2セル～AF2セルは、AD2セルをコピー
B3セルは、=B2 C3セル～AF3セルは、B3セルをコピー
B3セル～AF3セルの「セルの書式設定」の「表示形式」は、「aaa」とします。
次に七曜カレンダーですが、まず以下を参考にしています。 http://www.h3.dion.ne.jp/~sakatsu/CalendarTopic.htm
具体的には、 AH2セル "日" AI2セル "月" AJ2セル "火" AK2セル "水" AL2セル "木" AM2セル "金" AN2セル "土" と入力し、 AH3セル =IF($B$2-WEEKDAY($B$2)+1<$B$2,"",$B$2-WEEKDAY($B$2)+1) AI3セル =IF($B$2-WEEKDAY($B$2)+2<$B$2,"",$B$2-WEEKDAY($B$2)+2) AJ3セル =IF($B$2-WEEKDAY($B$2)+3<$B$2,"",$B$2-WEEKDAY($B$2)+3) AK3セル =IF($B$2-WEEKDAY($B$2)+4<$B$2,"",$B$2-WEEKDAY($B$2)+4) AL3セル =IF($B$2-WEEKDAY($B$2)+5<$B$2,"",$B$2-WEEKDAY($B$2)+5) AM3セル =IF($B$2-WEEKDAY($B$2)+6<$B$2,"",$B$2-WEEKDAY($B$2)+6) AN3セル =$B$2-WEEKDAY($B$2)+7 AH15セル =AN3+1 AI15セル =AH15+1 AJ15セル～AN15セルは、AI15セルをコピー AH27セル～AN27セルは、AH15セル～AN15セルをコピー AH39セル～AN39セルは、AH15セル～AN15セルをコピー AH51セル =IF($B$2-WEEKDAY($B$2)+29>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+29) AI51セル =IF($B$2-WEEKDAY($B$2)+30>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+30) AJ51セル =IF($B$2-WEEKDAY($B$2)+31>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+31) AK51セル =IF($B$2-WEEKDAY($B$2)+32>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+32) AL51セル =IF($B$2-WEEKDAY($B$2)+33>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+33) AM51セル =IF($B$2-WEEKDAY($B$2)+34>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+34) AN51セル =IF($B$2-WEEKDAY($B$2)+35>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+35) AH63セル =IF($B$2-WEEKDAY($B$2)+36>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+36) AI63セル =IF($B$2-WEEKDAY($B$2)+37>DATE(YEAR($B$2),MONTH($B$2)+1,DAY($B$2))-1,"",$B$2-WEEKDAY($B$2)+37) 以上のような設定をしたうえで、以下のコードを実行すれば、できると思います。
Sub Sample() Dim WS1 As Worksheet Dim vntData As Variant Dim vntResult As Variant Dim lngRow As Long Dim lngColumn As Long Dim lngRowResult As Long Dim c As Range
Set WS1 = ActiveSheet
With WS1.Range("A2")
vntData = .Resize(.Offset(.Parent.Rows.Count - .Row).End(xlUp).Row - .Row + 1, 32)
End With
ReDim vntResult(1 To 10, 1 To 32)
For lngColumn = 2 To UBound(vntData, 2)
lngRowResult = 0
For lngRow = 3 To UBound(vntData, 1)
If vntData(lngRow, lngColumn) <> "" Then
lngRowResult = lngRowResult + 1
If lngRowResult > 10 Then
MsgBox vntData(1, lngColumn) & " は、10名を超えています"
Exit For
End If
vntResult(lngRowResult, lngColumn) = vntData(lngRow, 1) & " " & vntData(lngRow, lngColumn)
End If
Next
Next
With WS1.Range("AH3").Resize(12 * 6, 7)
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents
On Error GoTo 0
For Each c In .SpecialCells(xlCellTypeFormulas, xlNumbers)
If IsDate(c.Value) Then
c.Offset(1).Resize(10).Value = Application.WorksheetFunction.Index(vntResult, 0, Day(c.Value) + 1)
End If
Next
End With
MsgBox "転記を終了しました" End Sub
なお、こちらで作成したサンプルファイルを以下にアップロードしましたので、よろしかったら、参考にどうぞ。 http://kamicha1.web.fc2.com/Excel/Calendar20090831.html
(かみちゃん) 2009/09/02 16:40
こんにちは。かみちゃん です。
>>> 開始時刻（？）の早い順、同じ開始時刻であれば、終了時刻（？）の早い順、ショートの場合は、最後 > > の順番の並べ替えはできていない
これに対応してみました。以下のようなコードでできると思います。
なお、コード内で使用しているVSortM は、 二次元配列で使用できるクイックソートを過去のスレッドより検索して、以下から拝借させていただきました。 [[20080521002252]]『セル内で使われた数字の整理』（さっぱりダメ）
Sub Sample() Dim WS1 As Worksheet Dim vntData As Variant Dim vntResult As Variant Dim lngRow As Long Dim lngColumn As Long Dim lngRowResult As Long Dim c As Range Dim v As Variant Dim vv As Variant Dim vvv As Variant Dim lngIndex() As Long
Set WS1 = ActiveSheet
With WS1.Range("A2")
vntData = .Resize(.Offset(.Parent.Rows.Count - .Row).End(xlUp).Row - .Row + 1, 32)
End With
ReDim vntResult(1 To 10, 1 To 32)
For lngColumn = 2 To UBound(vntData, 2)
lngRowResult = 0
For lngRow = 3 To UBound(vntData, 1)
If vntData(lngRow, lngColumn) <> "" Then
lngRowResult = lngRowResult + 1
If lngRowResult > 10 Then
MsgBox vntData(1, lngColumn) & " は、10名を超えています"
Exit For
End If
vntResult(lngRowResult, lngColumn) = vntData(lngRow, 1) & " " & vntData(lngRow, lngColumn)
End If
Next
Next
With WS1.Range("AH3").Resize(12 * 6, 7)
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents
On Error GoTo 0
ReDim v(1 To 10, 1 To 2)
ReDim lngIndex(1 To 10)
For Each c In .SpecialCells(xlCellTypeFormulas, xlNumbers)
If IsDate(c.Value) Then
lngColumn = Day(c.Value)
For lngRow = 1 To 10
v(lngRow, 1) = vntResult(lngRow, lngColumn + 1)
vv = Split(v(lngRow, 1), " ")
If UBound(vv) > 0 Then
vvv = Split(vv(1), "～")
If UBound(vvv) > 0 Then
v(lngRow, 2) = Format(vvv(0), "hhmm") & Format(vvv(1), "hhmm")
End If
Erase vvv
End If
Erase vv
lngIndex(lngRow) = lngRow
Next
'二次元配列の1番目から10番目を2列目をキーに昇順にソート
VSortM v, 1, 10, 2, 1
lngRowResult = 0
For lngRow = 1 To 10
vntResult(lngRow, lngColumn + 1) = Empty
If v(lngIndex(lngRow), 1) <> "" Then
lngRowResult = lngRowResult + 1
vntResult(lngRowResult, lngColumn + 1) = v(lngIndex(lngRow), 1)
End If
Next
c.Offset(1).Resize(10).Value = Application.WorksheetFunction.Index(vntResult, 0, lngColumn + 1)
End If
Next
End With
MsgBox "転記を終了しました" End Sub
Sub VSortM(ary, LB, UB, ref, myOrd As Long)
Dim i As Long, ii As Long, iii As Long, M, temp
i = UB: ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
If myOrd <> 0 Then
Do While ary(ii, ref) < M: ii = ii + 1: Loop
Do While ary(i, ref) > M: i = i - 1: Loop
Else
Do While ary(ii, ref) > M: ii = ii + 1: Loop
Do While ary(i, ref) < M: i = i - 1: Loop
End If
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
Next
i = i - 1: ii = ii + 1
End If
Loop
If LB < i Then VSortM ary, LB, i, ref, myOrd
If ii < UB Then VSortM ary, ii, UB, ref, myOrd
End Sub
なお、こちらで作成したサンプルファイルを以下にアップロードしましたので、よろしかったら、参考にどうぞ。 http://kamicha1.web.fc2.com/Excel/Calendar20090831.html Calendar20090902.zipのほうが、並べ替え対応版になります。
(かみちゃん) 2009/09/02 19:23
かみちゃん様
貴重なお時間を使って作成して頂きありがとうございました。 上手く使えそうです。
本当にありがとうございました。
(ぷーこ)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.