シート１の氏名日付がした記号をシート２に反映

質問

シート１のマークを入力コマンドボタンでシート２に氏名、日付マッチしたセルに画像のように入力したいのですがコードがお解りになる方どうかよろしくお願いします。

回答No.1

tom04 · ベストアンサー

こんにちは！
今回は関数だけで対応できそうな感じですが・・・

仮に関数でやる場合は
Sheet2のB2セルに
=IFERROR(INDEX(Sheet1!$1:$1048576,MATCH($A2,Sheet1!$A:$A,0),MATCH(B$1,Sheet1!$1:$1,0))&"","")
として列・行方向にオートフィルでコピー！
（Excel2007以降の場合です）

どうしてもコマンドボタンで操作したい場合は
前回同様、標準モジュールに一旦↓のコードをコピー＆ペーストしておきます。

Sub Sample2()
Dim i As Long, j As Long, k As Long, L As Long
Dim wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")

i = wS2.Cells(Rows.Count, 1).End(xlUp).Row
j = wS2.Cells(1, Columns.Count).End(xlToLeft).Column
Range(wS2.Cells(2, 2), wS2.Cells(i, j)).ClearContents
On Error Resume Next
For i = 2 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountA(wS1.Rows(i)) > 1 Then
For j = 2 To wS1.Cells(i, Columns.Count).End(xlToLeft).Column
If wS1.Cells(i, j) <> "" Then
k = WorksheetFunction.Match(wS1.Cells(i, 1), wS2.Columns(1), False)
L = WorksheetFunction.Match(wS1.Cells(1, j), wS2.Rows(1), False)
wS2.Cells(k, L) = wS1.Cells(i, j)
End If
Next j
End If
Next i
End Sub

次にコマンドボタンのコードを↓にしてみてください。

Private Sub CommandButton1_Click()
Call Sample2
End Sub

こんなんではどうでしょうか？m(_ _)m

お礼

有難うございます。すごいです、悩んでいたのので非常に助かりました。