| |
▼COM さん：
こんにちは
もう解決済みのようですが、勉強のため
試しに作ってみましたので参考になれば・・・
↓（合ってるのかな？）
Option Explicit
Sub test()
Dim ws As Worksheet
Dim sryo As Long
Dim syok As Long
Dim gos As Long
Dim gok As Long
Dim i As Long
Dim ed As Long
Dim pls As Long
ThisWorkbook.Worksheets("Sheet1").Cells.Copy Destination:=ThisWorkbook.Worksheets("sheet2").Cells
Set ws = ThisWorkbook.Worksheets("Sheet2")
i = 1
ed = ws.Range("A65535").End(xlUp).Row
Do Until i > ed
pls = ws.Cells(i, 1)
syok = 0
sryo = 0
Do While pls = ws.Cells(i, 1)
sryo = sryo + ws.Cells(i, 6)
syok = syok + ws.Cells(i, 8)
i = i + 1
Loop
ws.Range(ws.Cells(i, 1), ws.Cells(i, 8)).Insert Shift:=xlDown
ws.Cells(i, 1) = "小計"
ws.Cells(i, 6) = sryo
ws.Cells(i, 8) = syok
gos = gos + sryo
gok = gok + syok
i = i + 1
Loop
ws.Cells(i, 1) = "合計"
ws.Cells(i, 6) = gos
ws.Cells(i, 8) = gok
ws.Activate
Set ws = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
