VBAの構文をご指導お願いいたします

質問

EXCELでシフト表を作成していますが次の操作をVBAで処理したいと考えていますが初心者で難しく教えて頂きたく宜しくお願いいたします。
1.sheet1でB1～AF1に日付、A2～A15に名前、日ごとに担当者を決め役割を記号(1)、(2)、（1）、（2）、等の記号をセルに入れてAさんは1日には(1)2日は(2)とこんな感じでシフト表を作成しています
2.Sheet2のB1～AF1に日付、A2に(1)、A3に（１）、A4に(2)～と記号を入れ、シフト表の逆で例えば1日の(1)は誰が担当者かを分かるようにSheet1のシフト表からSheet2のセルに担当者を代入する表を作りたいのです（ここの構文を教えて頂きたい）。Range("A1").Valueでお願いしますRC形式だと分からないのです勝手で説明が下手ですいません、何卒宜しくお願いたします。

回答No.2

tom04 · ベストアンサー

No.1です。

投稿後気になったので、再び顔を出しました。
VBAで！というご希望なので、もしかして同じ日に「役割」の重複があるのでしょうか？
その場合は関数では難しいので、やはりVBAになってしまうと思います。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り（VBE画面を閉じて）マクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, c As Range, wS As Worksheet
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
.Range("B2:AF15").ClearContents
For j = 2 To wS.Cells(1, Columns.Count).End(xlToLeft).Column 'B列～1行目データが入っている最終列まで
For i = 2 To 15 '2行目～15行目まで
'▼　Sheet1のi行・j列にデータがあれば、Sheet2のA列何行目のデータと一致するか？
If wS.Cells(i, j) <> "" Then
Set c = .Range("A:A").Find(what:=wS.Cells(i, j), LookIn:=xlValues, lookat:=xlWhole)
'▼　Sheet2の一致した行のj列が空白の場合は、Sheet1のi行・A列データをそのまま表示
'そうでない場合は今あるデータと「半角スペース」と新たにSheet1のi行・A列データを追加表示
With .Cells(c.Row, j)
If .Value = "" Then
.Value = wS.Cells(i, "A")
Else
.Value = .Value & " " & wS.Cells(i, "A")
End If
End With
End If
Next i
Next j
.Columns.AutoFit
End With
End Sub 'この行まで

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

補足

有難うございます。
1.の方法ですと、B2にコピーすると '); がB3に入りB4に式が入ります、B3は削除すれば問題は解消されます。
2.の方法ではWith .Cells(c.Row, j)ここがデバッグとなり進みません、1.の方法ですと他の人に式を消去されてしまうので出来ればVBAで作りたいと考えています。
同日に二人が同記号になることはあり得るのですがその時には同記号のセルを増やして二段構えで表示させたいと考えています。記号は(1)、（１）、の感じです。
宜しくお願いいたします

回答No.1

tom04

こんばんは！
Sheet1とSheet2の列の日付は一致しているのですね？

今回の質問に関して、わざわざVBAでなくても関数の方が簡単だと思います。
一例です。
同じ日に「役割」の重複はない！という前提です。

↓の画像でSheet2のB2セルに
=IF(COUNTIF(Sheet1!B$2:B$15,$A2),INDEX(Sheet1!$A$2:$A$15,MATCH($A2,Sheet1!B$2:B$15,0)),"")
という数式を入れ、列・行方向にフィルハンドルでコピー！
これで画像のような感じになります。m(_ _)m