シート1の氏名をシート2に反映

質問

sheet1の氏名をsheet2の日付、記号（A,B,C）にマッチした位置に入力させたいのですが下記コードで他で試したのですがうまくいきません。どなたかコードが解る方よろしくお願いします。

Sub 入力()
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.Range(wS2.Cells(6, 1), wS2.Cells(8, 1))
j = wS2.Cells(3, Columns.Count).End(xlToLeft).Column
Range(wS2.Cells(3, 2), wS2.Cells(i, j)).ClearContents
On Error Resume Next
For i = 2 To wS1.Cells(Rows.Count, 4).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, 4), wS2.Range(wS2.Cells(6, 1), wS2.Cells(8, 1)), False)
L = WorksheetFunction.Match(wS1.Cells(5, j), wS2.Rows(3), False)
wS2.Cells(k, L) = wS1.Cells(i, j)
End If
Next j
End If
Next i
End Sub

回答No.3

tom04 · ベストアンサー

No.2です。

どうしてもVBAでやりたいというコトですので・・・

標準モジュールに一旦↓のコードをコピー＆ペーストしておいてください。

Sub Sheet2に表示()
Dim i As Long, j As Long, k As Long
Dim wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")

Application.ScreenUpdating = False
j = wS2.UsedRange.Columns.Count
For i = 6 To wS2.Cells(Rows.Count, 1).End(xlUp).Row Step 6
wS2.Cells(i, 2).Resize(3, j).ClearContents
Next i
On Error Resume Next
For i = 3 To wS2.Cells(Rows.Count, 2).End(xlUp).Row Step 6
For j = 2 To wS2.Cells(i, Columns.Count).End(xlToLeft).Column
k = WorksheetFunction.Match(wS2.Cells(i, j), wS1.Rows(5), False)
wS1.Cells(13, k).Resize(3, 1).Copy wS2.Cells(i, j).Offset(3)
Next j
Next i
Application.ScreenUpdating = True
End Sub

次にSheet1のコマンドボタンのコードを↓にして、コマンドボタンをクリック！

Private Sub CommandButton1_Click()
Call Sheet2に表示
End Sub

こんなんではどうでしょうか？

※　上記コードはお示しの画像通りの配置としていますので、
Sheet1およびSheet2の配置が少し変わっただけでも
まったく意味のないコードになってしまいます。m(_ _)m

お礼

有難うございます。大変助かりました。

回答No.2

tom04

こんにちは！
おそらく前回回答した者です。

Sheet2の配置が前回のものとはかなり違っていますので、当然前回のコードはかなり変更する必要があります。

VBAで操作する場合、1行・1列ずれただけでも全く意図しない動きになってしまいます。
特に今回のように同列に同じデータが存在する場合
MATCH関数を使用できませんので
VBAで行うよりSheet関数の方が簡単で、メンテナンスもやりやすいと思います。

そういうコトで今回は関数での一例です。
Excel2007以降のバージョンをお使いだとして・・・

Sheet2のB6セルに
=IFERROR(INDEX(Sheet1!$1:$1048576,MATCH($A6,Sheet1!$D:$D,0),MATCH(B$3,Sheet1!$5:$5,0)),"")
という数式を入れ列・行方向にオートフィルでコピー

同様にB12セルに
=IFERROR(INDEX(Sheet1!$1:$1048576,MATCH($A12,Sheet1!$D:$D,0),MATCH(B$9,Sheet1!$5:$5,0)),"")

B18セルに
=IFERROR(INDEX(Sheet1!$1:$1048576,MATCH($A18,Sheet1!$D:$D,0),MATCH(B$15,Sheet1!$5:$5,0)),"")

と数式を入れそれぞれオートフィルで列・行方向にオートフィルでコピー！

これでなんとかSheet2の方は表示できると思います。

※　もちろんVBAでもできますが、こちらの方をおススメします。m(_ _)m

お礼

大変有難うございます。Excel関数でできました。でもなんとかVBAにて処理したいのですがやはり難しいでしょうか。

回答No.1

bin-chan

> 他で試したのですがうまくいきません。
どううまくいかないの？

そもそも「シート１のどれが氏名なのか」がわからない。
例示なら「○○　太郎」など、わかりやすくしてください。

お礼

すみません。ありがとうございます。