データを操作する技

質問

Sheet1に下記の様なデータがあり
1 5001 10
1 5010 13
1 5231 15
2 5002 16
2 5035 12
2 5354 14
3 5016 16
3 5201 12
3 5421 3
3 5354 12
4 5642 20
4 5016 500
4 5320 254
下記の様にSheet2を変更したいです
※もともと5001の行から5201の行までと1の列から5の列までは表があり
　表にない5010から下の行は追加します
　その上で数値だけを表の中に入れたいです
　　　　　　　1　　　2　　　3　　　4　　　5
5001　　　　10
5421　　　　　　　　　　　　3
5231　　　　15
5002　　　　　　　　16　　
5320　　　　　　　　　　　　　　　254
5354　　　　　　　　14　　12
5642　　　　　　　　　　　　　　　20
5201　　　　　　　　　　　　12

5010　　　　13
5035　　　　　　　　12
5016　　　　　　　　　　　　16　500
良い方法があればご教授下さい。
お願い致します。

回答No.1

Wendy02 · ベストアンサー

多く解答が出たら、それぞれ研究してみてくださいね。
こういうのは、VBAが一番良いと思います。
Sheet2のデータは、まったくなしでも、作動します。
ただ、このマクロは、Sheet2の既にあるデータをクリアしているわけではありませんので、使用の際には注意してください。
また、5010からの新データに対して、分かち行としての空白行はつきません。

Sub test()
　Dim ary As Variant
　Dim wsh_rng As String
　Dim rng As Range
　Dim ret As Integer
　Dim Sh2 As Worksheet
　Dim num As Variant, j As Long, i As Long
　Dim ans As Variant
　Dim r As Range
　Worksheets("Sheet1").Activate 'シート1をアクティブにする
　Set Sh2 = Worksheets("Sheet2") 'シート2 を設定
　Set rng = Range("A1").CurrentRegion
　'アクティブシートのA1からの連続した範囲
　ary = rng.Value '配列として取得
　num = Application.Max(Range("A:A"))
　If num < 1 Or num > 1000 Then MsgBox "データが不明です", 16: Exit Sub
　'列の数字チェック
　wsh_rng = rng.Columns(1).Address & _
　"&" & rng.Columns(2).Address & _
　"&" & rng.Columns(3).Address
　If Evaluate("Sum((Match(" & wsh_rng & ", " & wsh_rng & ", 0) = Row(" & _
　　rng.Columns(1).Address & ")) * 1)") <> UBound(ary) Then
　　ret = MsgBox("データにダブりがあります。" & Chr(13) _
　　& "上書きして実行しますか?", 64 + vbYesNo)
　　'配列数式によるダブりのチェック
　　If ret <> vbYes Then
　　　Exit Sub
　　End If
　End If
　With Sh2
　　If Application.CountA(.Range("A1").Offset(, j)) <> j Then
　　　For j = 1 To num
　　　　.Range("A1").Offset(, j).Value = j
　　　Next
　　End If
　　For i = LBound(ary) To UBound(ary)
　　　ans = Application.Match(ary(i, 2), .Range("A:A"), 0)
　　　If Not IsError(ans) Then
　　　　.Cells(ans, 1).Offset(, ary(i, 1)).Value = ary(i, 3)
　　　　Else
　　　　Set r = .Range("A65536").End(xlUp).Offset(1)
　　　　r.Value = ary(i, 2)
　　　　r.Offset(, ary(i, 1)).Value = ary(i, 3)
　　　End If
　　Next i
　End With
　Set r = Nothing
　Set Sh2 = Nothing
End Sub

お礼

お礼が遅れて大変申し訳ないです
とても参考になりました
ありがとうございます。

回答No.3

Wendy02

#1 の私の書き込みの補足です。

>ただ、このマクロは、Sheet2の既にあるデータをクリアしているわけではありませんので、使用の際には注意してください。

それを修正するには、Sub という行から、12行目に、
Set Sh2 = Worksheets("Sheet4") 'シート2 を設定
'つまり、上の行の下に三行を挿入すれば、データは、そのつどクリアされます。
With Sh2.Range("A1").CurrentRegion.Offset(1, 1)
　　.Resize(.Rows.Count - 1, .Columns.Count - 1).ClearContents
End With

とすれば、良いです。

回答No.2

macchan1

このケースでは関数でやるほうが簡単かもしれません。

元のデータがSheet1のA1セルからA100セル以内に入っていて、表示したいセルのA列に４桁の番号、B2セルから右方向に１～5までが入力されている場合以下の式を２列目のセルに入力し、下方向及び右方向にオートフィル(コピー）すればOKです（以下の例はB12セルに入力する場合ですので、$A11の部分は実際に数式を入力するセルの行番号に合わせてください）。

=IF(SUMPRODUCT((Sheet1!$A$1:$A$100=B$1)*(Sheet1!$B$1:$B$100=$A11))=0,"",OFFSET(Sheet1!$C$1,SUMPRODUCT((Sheet1!$A$1:$A$100=B$1)*(Sheet1!$B$1:$B$100=$A11)*ROW($A$1:$A$100))-1,0))

お礼

こんなやり方もあるんですね
参考にさせて頂きます
ありがとうございます