|
▼moon さん:
こんにちは!
あまり早いコードではないですが、
A列ソート前提のシート1からシート2へのサンプルコードです。
Sub test0()
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim RwA1 As Long
Dim RwA2 As Long
Dim i As Long
Dim j As Long '指定範囲の最初の値
Dim k As Long '指定範囲の最後の値
Set Ws1 = ThisWorkbook.Worksheets(1) 'シート1番目
Set Ws2 = ThisWorkbook.Worksheets(2) 'シート2番目
With Ws1
RwA1 = .Range("A" & .Rows.Count).End(xlUp).Row 'A列の最終行
j = 1 '初期値
For i = 1 To RwA1
If .Range("A" & i).Value <> .Range("A" & i + 1).Value Then
If Ws2.Range("A1").Value = "" Then
RwA2 = 1
Else
RwA2 = Ws2.Range("A" & Ws2.Rows.Count).End(xlUp).Row + 1
End If
k = .Range("A" & i).Row '指定範囲値の取得
Ws2.Range("A" & RwA2).Value = .Range("A" & i).Value
Ws2.Range("B" & RwA2).Value = WorksheetFunction.Max(.Range("B" & j & ":B" & k))
Ws2.Range("C" & RwA2).Value = WorksheetFunction.Max(.Range("C" & j & ":C" & k))
Ws2.Range("D" & RwA2).Value = WorksheetFunction.Sum(.Range("D" & j & ":D" & k))
Ws2.Range("E" & RwA2).Value = WorksheetFunction.Sum(.Range("E" & j & ":E" & k))
j = .Range("A" & i + 1).Row '次の範囲の最初の値へ
End If
Next
End With
Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub
|
|