| |
素人じゅうすけ さん こんばんわ
2項目の日付表示について
C列に縦方向に表示ではなく、同じ行の右方向に表示でしたら割と簡単です。
最初に提示した行挿入が無いコードに追加してください
Sub Test2()
Dim R As Long, r2 As Long '元データの行数と転記先の行番号
Dim 人名 As String
Dim Sum As Double
R = UsedRange.Rows.Count
人名 = InputBox("抽出する人")
For Each Rng In Range(Range("C2"), Cells(R, 3))
If Rng.Value = 人名 Then
'G列から取り出して合計する
Sum = Sum + Rng.Offset(0, 4).Value
End If
Next
With Sheets("Sheet4")
r2 = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(r2, 1) = 人名
.Cells(r2, 2) = Sum
For Each Rng In Range(Range("C2"), Cells(R, 3)) '●ここから
If Rng.Value = 人名 Then
日付 = Rng.Offset(0, -2)
.Cells(r2, 1).End(xlToRight).Offset(0, 1) = 日付
End If
Next '●ここまでを追加
End With
'降順に並べ替え
With Sheets("Sheet4")
.Activate
'データが１件以上あったら並び替えをする
If .Range("A3") <> "" Then
.Range("A1").Select
Selection.Sort Key1:=.Range("B2"), Order1:=xlDescending
End If
End With
End Sub
これでも空白行を入れると
.Range("A1").Select
Selection.Sort Key1:=.Range("B2"), Order1:=xlDescending
では最初の空白行以降は並び替えの対象にならないので
.Range("A1").Select を全セルを対象にして .Cells.Select としなければなりません。
また、この場合は並び替えられたら空白行は全て取り除かれます。
ということで加工の対象となるデータは極力空白行を作ったりしない方がよいと思います。
必要なら全て作業が終わってから表を整えるのが良いと思います。
|
|
yata
- 06/11/15(水) 21:34 -
