[[20100623171114]] 『二つの表を一緒に作成する』(がんた) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『二つの表を一緒に作成する』(がんた)
宜しくお願いいたします。下記のような表を作成すると同時に
 月(28日) 火(29日) 水(30日) 木(1日)   金(2日)  

 山本8:45   鈴木8:30   山本8:45   鈴木8:30   山本8:40
 竹下9:20   小野9:20   増田9:20   増田9:20   松本 9:50
 石垣10:40  櫻井11:30

 北川1:20   増田1:30   佐藤1:30   望月1:30   岩田2:00	
 増田2:30   鈴木2:40   鈴木2:20   塩谷2:00   安藤3:00	
 松本3:40   八木3:20   増井2:40   増田4:00   小田4:30	

下の表に反映させたいのですが。。。

 増田 様  今週の訪問予定 	

 訪問日(曜日)  午前   午後
  
 28日 (月)        2:30

 29日 (火)          1:30

 30日 (水)   9:20

  1日 (木)        4:00

上は曜日別。下は人別です。。。無理でしょうか。。。?


 >月(28日)
 >山本8:45
 これらのデータは、1つのセルに入力してあるの?
 であれば、かなりややこいなぁー!
 (kei)

 あと、、、
 時間はできれば、24時間で記入したほうがいいかも。。。
 
 (キリキ)(〃⌒o⌒)b

ありがとうございます。

 月(28日)はひとつのセルですが、分ける事は可能です。
 で、山本 8:45は別々のセルです。
 勿論時間を24時間で表現するのも可能です。
 どうかご指導下さい〜。。。
 宜しくお願い致します。 (がんた)


 考えてみたら、かなり難しいですね・・・
 
 表構成も勝手に考えて見ましたが、実際に運用するのには向いていないと思います。
 もっと運用しやすい案が出ると思いますので、それまでのたたき台程度に・・・
 
Sheet1	[A]	[B]	[C]	[D]	[E]	[F]	[G]	[H]	[I]	[J]
[1]	28日	(月)	29日	(火)	30日	(水)	1日	(木)	2日	(金)
[2]	山本	8:45	鈴木	8:30	山本	8:45	鈴木	8:30	山本	8:40
[3]	竹下	9:20	小野	9:20	増田	9:20	増田	9:20	松本	9:50
[4]	石垣	10:40	櫻井	11:30	佐藤	13:30	望月	13:30	岩田	14:00
[5]	北川	13:20	増田	13:30	鈴木	14:20	塩谷	14:00	安藤	15:00
[6]	増田	14:30	鈴木	14:40	増井	14:40	増田	16:00	小田	16:30
[7]	松本	15:40	八木	15:20						
 
 A1 シリアル値で日付を入力 2010/6/28
 B1 =A1
 C1 =A1+1
 B1:C1 を範囲選択して、J1 までフィルコピー
 
Sheet2	[A]	[B]	[C]	[D]
[1]	増田	様	今週の訪問予定	
[2]				
[3]	訪問日(曜日)		時間	
[4]	28日	(月)	14:30	
[5]	29日	(火)	13:30	
[6]	30日	(水)	9:20	
[7]	1日	(木)	9:20	16:00
[8]	2日	(金)		
 
 A1 に検索したい人名入力
 A4 =Sheet1!A1
 A5 =A4+1
 A8までコピー
 B4 =TEXT(A4,"(aaa)")
 B8までコピー
 C4 =IF(COUNTIF(INDEX(Sheet1!$A$2:$J$7,,MATCH($A4,Sheet1!$A$1:$J$1,)),$A$1)<COLUMN(A1),"",
    INDEX(Sheet1!$A$2:$J$7,SMALL(IF(INDEX(Sheet1!$A$2:$J$7,,MATCH($A4,Sheet1!$A$1:$J$1,))=$A$1,ROW($A$1:$A$6),""),COLUMN(A1)),MATCH($A4,Sheet1!$A$1:$J$1,)+1))
 ↑上記は配列数式
 Ctrl + Shift + Enter で確定
 { 数式 } となればOK
 必要範囲までコピー
 
 ※例題のように1日分、7名までで考えています。
  ご覧のとおり、複雑でわけのわからん数式になってますw
 
 
 入力時点で、縦軸が人名・横軸が日付と午前と午後になっていれば、オートフィルタだけで確認しやすくできると思いますb
 
	[A]	[B]	[C]	[D]	[E]	[F]	[G]	[H]	[I]	[J]	[K]
[1]		28日	(月)	29日	(火)	30日	(水)	1日	(木)	2日	(金)
[2]		午前	午後	午前	午後	午前	午後	午前	午後	午前	午後
[3]	山本	8:45				8:45				8:40	
[4]	竹下	9:20									
[5]	石垣	10:40									
[6]	北川		13:20								
[7]	増田		14:30			9:20					
[8]	松本		15:40							9:50	
[9]	鈴木			8:30	14:40		14:20	8:30			
[10]	小野			9:20							
[11]	櫻井			11:30							
[12]	増田				13:30			9:20	16:00		
[13]	八木				15:20						
[14]	佐藤						13:30				
[15]	増井						14:40				
[16]	望月								13:30		
[17]	塩谷								14:00		
[18]	岩田										14:00
[19]	安藤										15:00
[20]	小田										16:30
 
 あんまり役に立っていない気がしますが・・・
 (キリキ)(〃⌒o⌒)b


 質問のように曜日別の表で、午前と午後をはっきり(上下に)分け、またある人が同じ日の午前あるいは午後に2回訪問することがなければ、もっと簡単になりますが。  (NB)

Keiさん、キリキさん、NBさんありがとうございます!

逆に作成する表自体を考え直すいい機会と思いました!

キリキさんの案を元に頑張ってみます!

また表を作り直してう〜ん・・・ってなったら質問ボードにやってくるかと思いますが・・・その時はまた皆様宜しくお願い致します!

ありがとうございました〜♪ (がんた)


 終わっちゃたみたいだけど・・アップしときます。。
 関数での処理は、わたしにはかなり難しいみたいなのでマクロで組んでみました。

 Sheet1
   |  A |  B  |  C |  D  |  E |  F  |  G |  H  |  I |  J  |  K |  L  |
 01|28日|(月) |29日|(火) |30日|(水) |1日 |(木) |2日 |(金) |3日 |(月) |
 02|山本|8:45 |鈴木|8:30 |山本|8:45 |鈴木|8:30 |山本|8:40 |山本|8:45 |
 03|竹下|9:20 |小野|9:20 |増田|9:20 |増田|9:20 |松本|9:50 |竹下|9:20 |
 04|石垣|10:40|櫻井|11:30|佐藤|13:30|望月|13:30|岩田|14:00|石垣|10:40|
 05|北川|13:20|増田|13:30|鈴木|14:20|塩谷|14:00|安藤|15:00|北川|13:20|
 06|増田|14:30|鈴木|14:40|増井|14:40|増田|16:00|小田|16:30|増田|21:30|
 07|松本|15:40|八木|15:20|    |     |    |     |    |     |松本|15:40|
 08|    |     |    |     |    |     |    |     |    |     |    |     |

 Sheet2
   |   A  |   B  |       C      |  D  |
 01|増田  |様    |今週の訪問予定|     |
 02|      |      |              |     |
 03|訪問日|(曜日)|午前          |午後 |
 04|28日  |(月)  |              |14:30|
 05|29日  |(火)  |              |13:30|
 06|30日  |(水)  |9:20          |     |
 07|1日   |(木)  |9:20          |16:00|
 08|3日   |(月)  |              |21:30|
 09|      |      |              |     |

 Sheet1の日付は文字列です。

 Sheet2のシートを開くと、氏名を入力するA1にドロップダウンリストでSheet1に出てくる人を選択できます。
 選択した時点で、処理をします。

 Sheet2のシートモジュールに張り付けてください。。

 Private Sub Worksheet_Activate()
    Dim dic As Object, strTEXT As String, 範囲 As String
    Dim k As Byte, i As Integer, j As Integer
    Dim vntItem As Variant, myRange As Range

    If Range("A3").Value = "" Then
        Range("B1:C1").Value = [{"様","今週の訪問予定"}]
        Range("A3:D3").Value = [{"訪問日","(曜日)","午前","午後"}]
    End If
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        For k = 1 To WorksheetFunction.CountA(Sheets("Sheet1").Range("A2:IV2"))
            For i = 2 To 20
                If .Cells(i, k).Value = "" Then Exit For
                strTEXT = .Cells(i, k).Value
                If dic.EXISTS(strTEXT) <> True And IsNumeric(strTEXT) = False Then
                    dic.Add strTEXT, strTEXT
                End If
            Next i
        Next k
        Range("O:O").Value = ""
        For Each vntItem In dic.items
            j = j + 1
            Cells(j, 15).Value = vntItem
        Next vntItem
    End With
    Range(Cells(1, 15), Cells(Rows.Count, 15).End(xlUp)).Name = "範囲"
    Range("A1").Validation.Delete
    For Each myRange In Range("A1")
        myRange.Validation.Add Type:=xlValidateList, _
            Formula1:="=" & Range("範囲").Address
    Next myRange
 End Sub

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim h As Byte, i As Long, j As Long, k As Long, l As String

    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Range("A4:D100").Value = ""
        With Sheets("Sheet1")
            h = WorksheetFunction.CountA(.Range(.Cells(1, "A"), .Cells(1, Columns.Count).End(xlToLeft)))
            For i = 1 To h - 1 Step 2
                j = WorksheetFunction.CountA(.Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp)))
                l = Cells(Rows.Count, "A").End(xlUp).Address
                For k = 2 To j
                    If .Cells(k, i).Value = Range("A1").Value Then
                        If Range(l).Value <> .Cells(1, i).Value Then
                            Range(l).Offset(1).Value = .Cells(1, i).Value
                            Range(l).Offset(1, 1).Value = .Cells(1, i + 1).Value
                        End If
                        If .Cells(k, i + 1).Value < TimeValue("12:00:00") Then
                           Range(l).Offset(1, 2).Value = Format(.Cells(k, i + 1).Value, "hh:mm")
                        Else
                           Range(l).Offset(1, 3).Value = Format(.Cells(k, i + 1).Value, "hh:mm")
                        End If
                    End If
                Next k
            Next i
        End With
    End If
 End Sub

 (kei)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.