原理的に、2つの表は、同じものだと思います。そこで、両者に共通のレベルで割り当て表(データベースのフォーマット)を
作成することを提案します。例えば、下記のようなものです。
date shop name
01/01 (月) 09:00 X店 A氏
01/02 (火) 09:00 Y店 A氏
01/01 (月) 09:00 Y店 B氏
01/03 (水) 09:00 Z店 B氏
01/02 (火) 09:00 Z店 C氏
01/03 (水) 09:00 休 C氏
3つの列を使います。
dateは、実入力は、2007/01/01 9:00 です。
書式を使って、曜日を表示しています。
お店と、人の配置は、この表で、やります。
次に示します、VBAで「お店ベースの表」と、「人ベースの表」を作成します。
「お店ベースの表」、「人ベースの表」は、単なる結果の表現の違いです。
----------------------------------------------
前提:
データベースフォーマットの入力をするシートのシート名は「Input」
「Table」と言う名称のシートが存在すること
----------------------------------------------
Sub CreatingTables()
Dim myDate(50) As Date
Dim myShop(50) As String
Dim myName(50) As String
Dim myArray As Variant
With Worksheets("Input")
E_rowpos = .Cells(1, 1).End(xlDown).Row
E_colpos = .Cells(1, 1).End(xlToRight).Column
hani = .Range(.Cells(1, 1), .Cells(E_rowpos, E_colpos)).Address
myArray = .Range(hani).Value
r = UBound(myArray, 1) '対象エリヤの行の数
c = UBound(myArray, 2) '対象エリヤの列の数
' -------------------------- Date調査----------------------------------------
.Range(hani).Sort _
Key1:=.Columns("A"), Order1:=xlAscending, Header:=xlYes
rowpos = 2
myCount = 0
myDate(0) = .Cells(2, 1).Value
Do While .Cells(rowpos, 1).Value <> ""
If .Cells(rowpos, 1).Value <> myDate(myCount) Then
myCount = myCount + 1
myDate(myCount) = .Cells(rowpos, 1).Value
End If
rowpos = rowpos + 1
Loop
myDateCount = myCount
' -------------------------- Shop調査----------------------------------------
.Range(hani).Sort _
Key1:=.Columns("B"), Order1:=xlAscending, Header:=xlYes
rowpos = 2
myCount = 0
myShop(0) = .Cells(2, 2).Value
Do While .Cells(rowpos, 1).Value <> ""
If .Cells(rowpos, 2).Value <> myShop(myCount) Then
myCount = myCount + 1
myShop(myCount) = .Cells(rowpos, 2).Value
End If
rowpos = rowpos + 1
Loop
myShopCount = myCount
' -------------------------- Name調査----------------------------------------
.Range(hani).Sort _
Key1:=.Columns("C"), Order1:=xlAscending, Header:=xlYes
rowpos = 2
myCount = 0
myName(0) = .Cells(2, 3).Value
Do While .Cells(rowpos, 1).Value <> ""
If .Cells(rowpos, 3).Value <> myName(myCount) Then
myCount = myCount + 1
myName(myCount) = .Cells(rowpos, 3).Value
End If
rowpos = rowpos + 1
Loop
myNameCount = myCount
End With
'--------------Nameの表の作成------------------------------------------------
With Worksheets("Table")
.Cells.Clear
For i = 2 To myDateCount + 2
.Cells(i, 1).Value = myDate(i - 2)
.Cells(i, 1).NumberFormat = "mm/dd (aaa) hh:mm"
Next
For j = 2 To myNameCount + 2
.Cells(1, j).Value = myName(j - 2)
Next
For j = 2 To r
tempDate = myArray(j, 1)
tempShop = myArray(j, 2)
tempName = myArray(j, 3)
For xi = 0 To myDateCount
If tempDate = myDate(xi) Then myPositionY = xi + 2: Exit For
Next
For xi = 0 To myNameCount
If tempName = myName(xi) Then myPositionX = xi + 2: Exit For
Next
.Cells(myPositionY, myPositionX).Value = tempShop
Next
End With
'--------------shopの表の作成------------------------------------------------
With Worksheets("Table")
For i = 2 To myDateCount + 2
.Cells(i, 1).Offset(myDateCount + 2 + 2, 0).Value = myDate(i - 2)
.Cells(i, 1).Offset(myDateCount + 2 + 2, 0).NumberFormat = "mm/dd (aaa) hh:mm"
Next
For j = 2 To myShopCount + 2
.Cells(1, j).Offset(myDateCount + 2 + 2, 0).Value = myShop(j - 2)
Next
For j = 2 To r
tempDate = myArray(j, 1)
tempShop = myArray(j, 2)
tempName = myArray(j, 3)
For xi = 0 To myDateCount
If tempDate = myDate(xi) Then myPositionY = xi + 2: Exit For
Next
For xi = 0 To myShopCount
If tempShop = myShop(xi) Then myPositionX = xi + 2: Exit For
Next
.Cells(myPositionY, myPositionX).Offset(myDateCount + 2 + 2, 0).Value = tempName
Next
End With
End Sub
補足
いい感じなのですが、右の表に1度ここに人を入れたいというデータ、例えば"9-19時"のような感じで使いたいので、これをVBEに入れることって出来ますか? 左の表に入れると右が埋まっていくのはとても良いです。