[[20190303221321]]　『エクセル　予定表から最初に行った日　できれば行』（みぎかた）　ページの最後に飛ぶ

『エクセル　予定表から最初に行った日　できれば行った場所の自動抽出』（みぎかた）

	A	B	C	D	E	F	G	H
1		4月1日	4月2日	4月3日	4月4日	4月5日	4月6日	4月7日
2		月	火	水	木	金	土	日
3	Aさん	東京1	東京1	東京1	千葉	東京1	東京1	
4		東京2	東京2	東京2		東京2	東京2	
5			東京3					
6	Bさん	埼玉	埼玉	埼玉	埼玉	埼玉	埼玉	
7								
8								
9	Cさん	埼玉	埼玉	埼玉	埼玉	埼玉	千葉	
10								
11

以降　Iが空白で　Jから4/8が始まります
この表から

最初に行った日　を抽出

表

		Aさん	Bさん	Cさん				
	東京1	4月1日						
	東京2	4月1日						
	東京3	4月2日						
	千葉	4月4日		4月6日				
	埼玉		4月1日	4月1日

の用に出したい。

できれば "東京1”も自動抽出

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 一つ質問。
 予定表では必ず3行で一人なのだろうか？
 （ただ私では行った場所の自動抽出の方法がまだ思い浮かばず多分行った場所を手入力での回答になると思う）
（ねむねむ） 2019/03/04(月) 09:45

休憩を利用してマクロ書いてみました

 Option Explicit

 Sub test()
    Dim dicX As Object, dicY As Object
    Dim x As Long, y As Long
    Dim c As Range
    Dim 氏名 As String, 場所 As String
    Dim 日付 As Date
    Dim i As Long, j As Long
    Dim n As Long
    Dim w()

    Set dicX = CreateObject("scripting.dictionary")
    Set dicY = CreateObject("scripting.dictionary")

    n = WorksheetFunction.CountA(Columns(1)) + 1

    x = 1
    y = 1

    For Each c In Columns(1).SpecialCells(xlCellTypeConstants).Cells
        氏名 = c.Value
        x = x + 1
        dicX(氏名) = x
        ReDim Preserve w(1 To n, 1 To y)
        w(x, 1) = 氏名
        For j = 1 To Cells(2).End(xlToRight).Column - 1
            日付 = Cells(1, 1 + j).Value
            For i = 0 To 2
                場所 = c.Offset(i, j).Value
                If 場所 <> "" Then
                    If Not dicY.exists(場所) Then
                        y = y + 1
                        dicY(場所) = y
                        ReDim Preserve w(1 To n, 1 To y)
                        w(1, y) = 場所
                    End If
                    If IsEmpty(w(x, dicY(場所))) Then
                        w(x, dicY(場所)) = 日付
                    End If
                End If
            Next
        Next
    Next

    Worksheets.Add.Cells(1).Resize(y, n).Value = Application.Transpose(w)

 End Sub

（マナ） 2019/03/04(月) 12:29

＞以降　Iが空白で　Jから4/8が始まります

ごめんなさい。これ見過していました。

（マナ） 2019/03/04(月) 12:53

ねむねむ様

ご貴重なお時間ありがとうございます！

予定表では必ず3行で一人なのだろうか？
→　必ず3行で一人となります。　増減はありません。

言った場所は、手動は入力でも構いません。
マクロで入力されたデータを重複なしで抽出がありましたので、
それでマメにやるを考えております。（一度行けばデータベース化されるので）

マナさま
ご貴重なお時間ありがとうございます！

空白を手動で消すでも、やれなくは無いです！
試してみます！
（みぎかた） 2019/03/04(月) 15:50

 予定表が横が１週間ごとに１列開けて５週間分AN列まであるとする。
 また、抽出先の表はA列が場所名、１行目が使命だとする。
 で、抽出表のB2セルに
 =IFERROR(SMALL(IF((OFFSET(予定表!$B$3:$AN$5,MATCH(B$1,予定表!$A:$A,0)-3,)=$A2),予定表!$B$1:$AN$1,""),1),"")
 と入力。
（ねむねむ） 2019/03/04(月) 16:16

 上記式をShiftキーとCtrlキーを押しながらEnterキーで確定（確定後、式が{}で囲まれればOK）その後、右及び下へフィルコピーしてみてくれ。

 あと、使命→氏名で。
（ねむねむ） 2019/03/04(月) 16:19

Sub main()

    Dim sht As Worksheet, c As Range, cc As Range, sname As String
    Set sht = Sheets("Sheet1")
    Sheets("Sheet2").Cells.ClearContents
    For Each c In sht.Rows(1).SpecialCells(2)
        If IsDate(c.Value) Then
            For Each cc In c.EntireColumn.SpecialCells(2)
                If cc.Row > 2 Then
                    sname = IIf(cc.EntireRow.Cells(1).Value <> "", cc.EntireRow.Cells(1).Value, cc.EntireRow.Cells(1).End(xlUp).Value)
                    If Sheets("Sheet2").Rows(1).Find(sname, , , xlWhole) Is Nothing Then
                          Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Value = sname
                    End If
                    If Sheets("Sheet2").Columns(1).Find(cc.Value, , , xlWhole) Is Nothing Then
                          Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = cc.Value
                    End If
                    If Sheets("Sheet2").Cells(Sheets("Sheet2").Columns(1).Find(cc.Value, , , xlWhole).Row, Sheets("Sheet2").Rows(1).Find(sname, , , xlWhole).Column).Value = "" Then
                        Sheets("Sheet2").Cells(Sheets("Sheet2").Columns(1).Find(cc.Value, , , xlWhole).Row, Sheets("Sheet2").Rows(1).Find(sname, , , xlWhole).Column).Value = c.Value
                    End If
                End If
            Next cc
        End If
    Next c
End Sub
（mm） 2019/03/04(月) 18:05

＞空白を手動で消すでも、やれなくは無いです！
＞試してみます！

マクロを少し修正するだけなので、わざわざ消す必要はありません。
ただ、ねむねむさん提示の数式でできるのだからマクロは不要ですね。

（マナ） 2019/03/04(月) 19:28

mm様　ありがとうございます！
すごすぎて
私の頭では応用できませんでした・・・。

勉強させて頂きます！

マナ様
ねむねむ様の数式を活用させて頂いているのですが、
行った場所の手動　抽出に時間がかかって苦戦しております・・・・。

（みぎかた） 2019/03/04(月) 23:27

コメント返信：

[ 一覧(最新更新順) ]

[[20190303221321]] 『エクセル 予定表から最初に行った日 できれば行』（みぎかた） ページの最後に飛ぶ

[[20190303221321]]　『エクセル　予定表から最初に行った日　できれば行』（みぎかた）　ページの最後に飛ぶ