[[20051009162020]]　『シート参照など』（ふぇいす）　ページの最後に飛ぶ

『シート参照など』（ふぇいす）

はじめまして。こんな質問が適切かはわかりませんがどなたか助けて下さい。

スタッフのシフト・座席管理を作成しています。

A　
1　　
　17：00～20：00　　山田太郎　　　1
2　　　17：00～21：00　　山田花子　　　2

とシートを作成し、別のシートに1を入力したら17：00～20：00までの時間表に色がつく。
という表の作成は可能でしょうか？
宜しくお願いします。

 こちらに統合しました。
（kazu）

『再・シート参照など』（ふぇいす）

先ほどの質問の表がうまく表示されていないまま更新してしまいました。
こちらの表が正しいものです。

はじめまして。こんな質問が適切かはわかりませんがどなたか助けて下さい。

スタッフのシフト・座席管理を作成しています。

A　　　　　　　　　　B　　　　　　　　　　C　　　　　　　　　D　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　1　　　　　　　　　17：00～20：00　　山田太郎　　　　　　　　　1　　　　　　　　　
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　2　　　　　　　　　17：00～21：00　　山田花子　　　　　　　　　2

とシートを作成し、別のシートに1を入力したら17：00～20：00までの時間表に色がつく。
という表の作成は可能でしょうか？
宜しくお願いします。

 Sheet1
 	    A         	   B        	C        
 1	17：00～20：00	山田太郎        	1
 2	17：00～21：00	山田花子        	2

 Sheet2の A1 に 1 が入れば Sheet1の A1:C1 に色が付き
 また、2 が入れば A2:C2 に色が付けばよいのでしょうか？
 もし、そのような事でしたら条件付き書式なんかでも可能だと思います。

 Sheet2のA1を選択し、メニュー⇒挿入⇒名前⇒定義⇒シフトとしてＯＫ。
 Sheet1のA1:C2を選択し、メニュー⇒書式⇒条件付書式⇒数式がを選び⇒ =$C1=シフト
 として⇒書式⇒パターンでお好みの色を選んでＯＫ。
　　　　　　　　　　　　　　　　　　　　　　　　　(SS)

SS様ありがとうございます。
でも・・少し違うんです。
私の説明が不十分でごめんなさい。

まず、1＝17：00～20：00
　　　2＝17：00～21：00
　　　3＝17：30～20：00　など色々パターンがあり、シート1のAに1と入力すると
シート2　に時間表がありそこの17：00～20：00に色がつく。という感じなんですが・・・無理ですかねぇ

 私が提示させて頂いたもので、Sheet2のA1に 1 とか 2、3 を入れると
 Sheet1 の対応する部分に色が付くはずなのですが......？
 これでは駄目なんですね～～～。　すみません。
　　　　　　　　　　　　　　　　　　　　　　　　　(SS)

 見当違いかもしれませんが、以下のようなことでしょうか。
http://skyblue123.hp.infoseek.co.jp/Excel/Time-schedule1.xls

 17：00～20：00　は計算を簡略化させるため、セルを分けています。

 （川野鮎太郎）

 VBA処理です
1) Sheet2のシート見出しを右クリックして「コードの表示」を選択
2) 右側空白部分に下記コードを貼り付けて、X をクリックしてエクセル画面に戻る

 Sheet2のA1値を変更すると作動します。

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim r As Range, colInd As Integer, ff As String
 If Target.Cells(1, 1).Address(0, 0) <> "A1" Then Exit Sub
 If IsEmpty(Target) Or Not IsNumeric(Target.Value) Then Exit Sub
    Select Case Target.Value
        Case 1
            txt = "17：00～20：00"
            colInd = 3
        Case 2
            txt = "17：00～21：00"
            colInd = 4
        Case 3
            txt = "17：30～20：00"
            colInd = 6
    End Select
    With Sheets("sheet1").Columns(1)
        Set r = .Find(txt, , , xlWhole)
        If Not r Is Nothing Then
            .Resize(, 2).Interior.ColorIndex = 0
            ff = r.Address
            Do
                r.Resize(, 2).Interior.ColorIndex = colInd
                Set r = .FindNext(r)
            Loop Until r.Address = ff
        End If
    End With
 End Sub
 (seiya)

コメント返信：

[ 一覧(最新更新順) ]

[[20051009162020]] 『シート参照など』（ふぇいす） ページの最後に飛ぶ

[[20051009162020]]　『シート参照など』（ふぇいす）　ページの最後に飛ぶ