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

エクセル　添付の予定表があります。


最初に行った日の抽出　
できれば行った場所も自動抽出

先生方のご教授をお願いいたします。

質問者からの補足コメント

• お恥ずかしい！
  添付小さすぎました！！
  すいません！

  
    補足日時：2019/03/03 17:17

• どうやったら見れるのか・・・

  
    補足日時：2019/03/03 17:22

• 予定表 B C D E F G H I（空白列）　J 3/8
  1　 　　 3/1　 3/2　3/3　
  2　　 　月　 火　　水
  3 Aさん 東京1 東京1 神奈川
  4 　 　　東京2 東京2
  5
  6 Bさん 神奈川 神奈川 東京1
  7 　　 東京2
  8
  9 Cさん 千葉　千葉　　千葉
  10
  11
  
  別のシート
  Aさんが　各場所　"東京1"などに最初に行った日を抽出
  "東京1"も　できれば自動で抽出
  
  Aさん Bさん　Cさん
  東京1 3/1　　3/3　　
  東京2 3/1 3/3
  神奈川 3/3 3/1
  千葉　 3/1

  
    補足日時：2019/03/03 18:06

• 予定表

  
    補足日時：2019/03/03 18:08

No.1 回答者： mike_g 回答日時： 2019/03/03 16:56

Hループを掛けても字が小さくて、かつ、不鮮明で、読めなーいッ！

No.2 回答者： mike_g 回答日時： 2019/03/03 17:24

何処が変わった？

相変わらず！！

本文中に書き写しなさい！

この回答へのお礼

すいません！
全然かわりません！

本文に書きます！！

お礼日時：2019/03/03 17:35

No.3 回答者： tom04 回答日時： 2019/03/03 22:17

こんばんは！

表示するSheetのA列は3行ずつ結合してあるのですね。

やり方だけ・・・
↓の画像のような配置になっているとします。

Sheet1のB3セルに
=IFERROR(INDEX(Sheet2!$A$2:$A$100,SMALL(IF(INDEX(Sheet2!$A$2:$Z$100,,MATCH(INDEX($A$3:$A$100,INT((ROW(A3)/3))*3-2),Sheet2!$1:$1,0))=B$1,ROW($A$2:$A$100)-1),MOD(ROW(A3),3)+1)),"")

配列数式なのでCtrl＋Shift＋Enterで確定！（←必須★）し
フィルハンドルで列・行方向にコピーすると
画像のような感じになります。

※　両シートとも行方向は100行目まで、
Sheet2の列範囲はZ列までの数式になっています。m(_ _)m

この回答へのお礼

tom04 さん
こんばんわ！
書き方が悪くごめんなさい！

sheet1　の情報から　sheet2を　抽出したいイメージです！
Aの列は結合なしです。
A3　Aさん
A4、A５は空白です。
A6　Bさん
A7、A８　空白

お礼日時：2019/03/03 22:51

No.4 回答者： tom04 回答日時： 2019/03/03 23:47

No.3です。

前回投稿したのとは全く逆のシート（前回の画像ではSheet2）のように表示したい！
というコトなのですね。

＞Aの列は結合なしです。
＞A3　Aさん
＞A4、A５は空白です。
＞A6　Bさん
＞A7、A８　空白

これをセルを結合してある！といいます。（No.3で指摘した通りです）
セル結合すると数式を使うにしても何かと厄介です。

手っ取り早く、VBAでの一例です。
前回アップした画像の配置通りだとし、Sheet2の1行目「名前」は入力済みだとします。

標準モジュールにしてください。

Sub Sample1()
　Dim i As Long, j As Long, myRow As Long
　Dim lastRow As Long, lastCol As Long
　Dim c As Range, r As Range, wS As Worksheet
　　Set wS = Worksheets("Sheet1")
　　　With Worksheets("Sheet2")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
　　　　　If lastRow > 1 Then
　　　　　　Range(.Cells(2, "A"), .Cells(lastRow, lastCol)).ClearContents
　　　　　End If
　　　　wS.Range("A:A").UnMerge
　　　　　For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row + 2
　　　　　　If wS.Cells(i, "A") = "" Then
　　　　　　　wS.Cells(i, "A") = wS.Cells(i - 1, "A")
　　　　　　End If
　　　　　Next i
　　　　　For j = 2 To wS.Cells(1, Columns.Count).End(xlToLeft).Column
　　　　　　For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　　If wS.Cells(i, j) <> "" Then
　　　　　　　　Set r = .Rows(1).Find(what:=wS.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　　Set c = .Range("A:A").Find(what:=wS.Cells(i, j), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　　　If c Is Nothing Then
　　　　　　　　　　myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
　　　　　　　　　Else
　　　　　　　　　　myRow = c.Row
　　　　　　　　　End If
　　　　　　　　　　.Cells(myRow, "A") = wS.Cells(i, j)
　　　　　　　　　　.Cells(myRow, r.Column) = wS.Cells(1, j)
　　　　　　　End If
　　　　　　Next i
　　　　　Next j
　　　　Application.DisplayAlerts = False
　　　　　For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row Step 3
　　　　　　wS.Cells(i, "A").Resize(3).Merge
　　　　　Next i
　　　　Application.DisplayAlerts = True
　　　End With
End Sub

※　とりあえずは前回アップした画像のSheet2のような感じになります。m(_ _)m

No.5 回答者： tom04 回答日時： 2019/03/04 00:07

何度もごめんなさい。

画像をよく見ると結合ではなく、3行毎にデータ（氏名）が入っているのですね。
いずれにしても、A列に空白があるとかなり面倒なので、
A列に空白がないようにすべての行に氏名がある方がその行のA列を参照できます。

前回のコードは最後に3行ずつセル結合していますので、

＞Application.DisplayAlerts = True
の次に
＞wS.Range("A:A").UnMerge

を追加してください。m(_ _)m

この回答へのお礼

tom04様
VBA勉強します！
応用が難しく勉強不足ですいません、、
貴重なお時間ありがとうございました！

お礼日時：2019/03/04 20:07

No.6 ベストアンサー 回答者： fujillin 回答日時： 2019/03/04 12:58

こんにちは

予定表（03/03 18:08投稿）から、出力表（03/03 18:06投稿）を作成したいってことですよね？


予定表のシート名をSheet1と仮定し、出力表のレイアウトがご提示の通り20行目から始まり、（列方向が不明ですが）A列に地名、B20：D20に人名が入力されているものと仮定します。

B21セルに
=IFERROR(1/(1/MIN(IF(OFFSET(Sheet1!$A$1,MATCH(B$20,Sheet1!$A$1:$A$100,0)-1,1,3,100)=$A21,Sheet1!$B$1:$CW$1))),"")
の式を入力して、Ctr + Shift + Enterで確定します。（←必須です）

その上で、右、下方向にフィルコピーではいかがでしょうか。

この回答へのお礼

fujillin様

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

まさにこれです！
応用して調整します！

ありがとうございました！

お礼日時：2019/03/04 20:09