| |
▼YN62 さん 今晩は
これでできると思います
Sheet2 で RRR が重複しているのが気になりますが、
試してみてください。
Sub 異なる表組みへの転記()
Dim k As Integer
Dim r1 As Range, r2 As Range
Dim 範囲11 As Range, 範囲12 As Range, 範囲13 As Range
Dim 範囲21 As Range, 範囲22 As Range
Dim UnionRng1 As Range, UnionRng2 As Range
'
With Sheets("Sheet1")
Set 範囲11 = .Range("A4", .Cells(65536, "A").End(xlUp).Offset(-1))
Set 範囲12 = .Range("C4", .Cells(65536, "C").End(xlUp).Offset(-1))
Set 範囲13 = .Range("E4", .Cells(65536, "E").End(xlUp).Offset(-1))
End With
With Sheets("Sheet2")
Set 範囲21 = .Range("A2", .Cells(65536, "A").End(xlUp).Offset(-1))
Set 範囲22 = .Range("D2", .Cells(65536, "D").End(xlUp).Offset(-1))
End With
'
Set UnionRng1 = Union(範囲11, 範囲12, 範囲13)
Set UnionRng2 = Union(範囲21, 範囲22)
'
For Each r1 In UnionRng1
For Each r2 In UnionRng2
If r1.Value = r2.Value Then
r2.Offset(, 1).Value = r1.Offset(, 1).Value
End If
Next
Next
'
Set 範囲11 = Nothing
Set 範囲12 = Nothing
Set 範囲13 = Nothing
Set UnionRng1 = Nothing
Set UnionRng2 = Nothing
End Sub
>シート１の三段組のデータを
>シート２に二段組のデータに仕上げたく思っています。
>
>シート１の行は30行くらいです。
>
>シート1と２の合計欄にはシート関数(Σ）が入っています。
>
>シート１
>氏名 点数１ 氏名 点数１ 氏名 点数 １
>AAA 5 FFF 4 YYY 5
>CCC 7 GGG 3 OOO 6
>BBB 8 KKK 7 PPP 10
>DDD 8 SSS 6 RRR 4
>合計 29 合計 20 合計 25
>
>シート２
> A B C D E F
>1 氏名 点数１ 点数２ 氏名 点数１ 点数 ２
>2 AAA 5 KKK 7
>3 CCC 7 RRR 4
>4 DDD 8 OOO 6
>5 BBB 10 RRR 4
>6 GGG 3 SSS 6
>7 FFF 4
>8 合計 37 0 合計 27 0
>
>※氏名の順番は、シート１とシート２は異なります。
>※シート２には氏名PPPはこの集計にはたまたま有りませんでした
>※点数２はシート１と同じような別のデータがあり、同じようにこのシートの氏名を基準に順次貼り付けてシート２の完成です。
>
>
>自分なりにマクロのコードを書きましたが、列がまたがってくるとどのように書けばよいのか分かりません。ご指導の程お願いいたします。
>
>
>Sub 異なる表組みへの転記()
>
>Dim k As Integer
>Dim R As Range
>Dim MyR As Range
>
>For k = 2 To 31
>
>Set MyR = Range(("A4"), Cells(65536, 1).End(xlUp))
>For Each R In MyR
>If R.Value = Sheets(2).Cells(k, 1).Value Then
>Sheets(2).Cells(k, 1).Offset(, 1).Value = R.Offset(, 1).Value
>
>End If
>
>Next
>Next
>
>End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
