一行の中から複数の値を抜き出す。

質問

エクセルを使用し、画像の上側のような表を作っています。説明の為、短くしてありますが実際のファイルは横にずらーっと日付が並んでおり、一年で一つのファイルです。月ごとにタブを設定しています。
部屋番号も下に10ほど並んでおります。
画像を一枚に収めるために、表を二つ入れてありますが、実際にはこの二つの表は別々のファイルにしたいです。(上側の表のファイル名を名簿.xlsxlとします)

名簿.xlsxを別のエクセルファイル(宿泊一覧.xlsx)から読み込んで、
名簿.xlsxから宿泊者名を自動で抜き出して、滞在日数や泊数を計算させて表を作成させることは可能でしょうか？
画像を一枚に収めるために、表を二つ入れてありますが、実際にはこの二つの表は別々のファイルにしたいです。
名簿.xslxをどんどん更新すると、宿泊一覧にも名前が更新されるようにしたいのですが、関数だけではできないものなんでしょうか？
VBAはよくわからないので、できれば関数でやるやり方を教えて頂ければありがたいです。

回答No.5

tom04

No.1～3です。

補足を読みました。
結局　名簿Bookには各月1Sheetで12Sheetあり、当然のコトながら月跨ぎでの宿泊もある！
というコトですね！
いずれにしても1年分を1Sheetにまとめた方が処理が簡単だと思います。
関数で！というとかなり厄介になりますので、VBAでやってみました。
ただし、下準備として
↓の画像で左側が「名簿」Bookの各Sheetのレイアウトになります。
Sheet見出し上には4月～翌年の3月までの12Sheetが存在するとしています。
「4月」のSheet見出しをクリック　→　Shiftキーを押しながら最後の3月のSheet見出しをクリック！
これで12Sheetが作業グループ化されましたので

A1セルを選択　→　右クリック　→　セルの書式設定　→　表示形式　→　ユーザー定義から
0年
と入力　→　OK
A2セルを選択　→　右クリック　→　セルの書式設定　→　表示形式　→　ユーザー定義から
0月度
と入力　→　OK
B1セル　→　セルの表示形式はユーザー定義から
d
としておき、
=IF(MONTH(DATE($A1,$A2,COLUMN(A1)))=$A2,DATE($A1,$A2,COLUMN(A1)),"")
という数式を入れます。
B2セルの数式は
=IF(B1="","",TEXT(B1,"aaa"))
として、B1・B2セルを範囲指定　→　B2セルのフィルハンドルで31日分のAF列までコピー！
→　Sheet見出し上で右クリック　→　作業グループ化を解除
各SheetのA1・A2セルに「年」と「月」の数値のみを入力していきます。
これで第一段階の準備は完了です。

この「名簿」Bookの13Sheet目を追加して　Sheet名を「作業用」としておきます。
VBAでこの「作業用」Sheetに1年分のデータを表示させ、
そのデータを利用し、↓の画面右側の「宿泊一覧」BookのSheet1に表示させます。

「宿泊一覧」のSheet1のD2セルに
=IF(A2="","",C2-B2+1)
E2セルに
=IF(A2="","",C2-B2)
という数式を入れ両列ともオートフィルでしっかり下へコピーしておいてください。
これで下準備は完了です。

最後に「名簿」Bookを開き　→　Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュールに
↓のコードをコピー＆ペーストしマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub 名簿更新() 'この行から
Dim i As Long, j As Long, k As Long, endRow As Long, endCol As Long
Dim c As Range, wS1 As Worksheet, wS2 As Worksheet

Application.DisplayAlerts = False
Workbooks.Open ("宿泊一覧")
Application.DisplayAlerts = True
Workbooks("名簿").Activate
Set wS1 = Worksheets("作業用")
Set wS2 = Workbooks("宿泊一覧").Worksheets("Sheet1")
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 1 Then
Range(wS2.Cells(2, "A"), wS2.Cells(endRow, "C")).ClearContents
End If
endRow = wS1.UsedRange.Rows.Count
If endRow > 1 Then
wS1.Rows(2 & ":" & endRow).ClearContents
End If
For k = 1 To 12
With Worksheets(k)
Set c = wS1.Rows(1).Find(what:=.Cells(1, "B"), LookIn:=xlValues, lookat:=xlWhole)
j = c.Column
endRow = .UsedRange.Rows.Count
endCol = .Cells(1, Columns.Count).End(xlToLeft).Column
Range(.Cells(2, "B"), .Cells(endRow, endCol)).Copy wS1.Cells(2, j)
End With
Next k
For i = 3 To wS1.UsedRange.Rows.Count
For j = 1 To wS1.Cells(1, Columns.Count).End(xlToLeft).Column
If wS1.Cells(i, j) <> "" And wS1.Cells(i, j) <> "→" And wS1.Cells(i, j) <> "退" Then
With wS2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Value = wS1.Cells(i, j)
.Offset(, 1) = wS1.Cells(1, j)
k = j
Do Until wS1.Cells(i, k) = "退"
k = k + 1
Loop
.Offset(, 2) = wS1.Cells(1, k)
End With
j = k
End If
Next j
Next i
wS2.Range("A1").CurrentRegion.Sort key1:=wS2.Range("B1"), order1:=xlAscending, Header:=xlYes
wS2.Columns.AutoFit
End Sub 'この行まで

※　今回も顧客名に重複はない！という前提です。
※　画像で、「田中」さんは月跨ぎにしてみました。
※　名簿シートの入力方法は画像のように最初に「お客様名」途中は「→」最後は「退」とします。

関数でないのでデータ変更があるたびにマクロを実行する必要があります。

この程度が今の段階では精一杯です。m(_ _)m