|
コードをコンパクトにしたいのですが
どなたかご教示お願いいたします。
<Sheet1> データ
A B C D
3 コード1 コード2 コード3 金額
4 1 2 1 33
5 1 2 1 34
1 4 1 9
1 3 1 22
2 1 1 100
2 2 1 45
1 3 1 78
2 1 1 67
<Sheet2> 転記先
A B C
2 コード1 コード2 金額
3 1 2 67
4 1 3 100
1 4 9
1 5 0
2 1 167
2 2 45
Sub test()
Sheets("Sheet1").Select
Range("J2") = 1 'コード3が1の場合
AA = 3
For i = 1 To 10
Sheets("Sheet2").Select
Range(Cells(AA, 1), Cells(AA, 1)).Select
If Range(Cells(AA, 1), Cells(AA, 1)) > 0 Then
Selection.Copy
Sheets("Sheet1").Select
Range("H2").Select 'コード1
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets("Sheet2").Select
Range(Cells(AA, 2), Cells(AA, 2)).Select
Selection.Copy
Sheets("Sheet1").Select
Range("I2").Select'コード2
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Range("A3:D20").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("H1:J2"), CopyToRange:=Range("F3:I3"), Unique:=False
'Range("H1:J2")=コード1,コード2,コード3,金額
'Range("F3:I3")"=コード1,コード2,コード3,金額
Sheets("Sheet1").Select
Range("k2").Select'金額の計
Selection.Copy
Sheets("Sheet2").Select
Range(Cells(AA, 3), Cells(AA, 3)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
AA = AA + 1
Next
End Sub
|
|