| |
▼kazu さん：
ついでに添削
Sub ボタン2_Click()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim sht4 As Worksheet
Dim sht5 As Worksheet
Dim sht As Worksheet
Dim i As Long
Dim y As Long
Set sht1 = Worksheets("徳永_受注予想")
Set sht2 = Worksheets("濱里_受注予想")
Set sht3 = Worksheets("矢崎_受注予想")
Set sht4 = Worksheets("佐藤_受注予想")
Set sht5 = Worksheets("井口_受注予想")
Set sht = Worksheets("Sheet1")
y = 2
With sht
.Cells.ClearContents
For i = 1 To 16
If i Mod 4 = 0 Then
.Cells(4, i + 1).Value = Application.Sum(.Range(.Cells(4, y), .Cells(4, i)))
.Cells(5, i + 1).Value = Application.Sum(.Range(.Cells(5, y), .Cells(5, i)))
.Cells(6, i + 1).Value = Application.Sum(.Range(.Cells(6, y), .Cells(6, i)))
.Cells(8, i + 1).Value = Application.Sum(.Range(.Cells(8, y), .Cells(8, i)))
.Cells(9, i + 1).Value = Application.Sum(.Range(.Cells(9, y), .Cells(9, i)))
.Cells(10, i + 1).Value = Application.Sum(.Range(.Cells(10, y), .Cells(10, i)))
y = y + 4
Else
.Cells(4, i + 1).Value = sht1.Cells(54, i + 1).Value + sht2.Cells(57, i + 1).Value _
+ sht3.Cells(54, i + 1).Value + sht4.Cells(54, i + 1).Value _
+ sht5.Cells(54, i + 1).Value
.Cells(5, i + 1).Value = 0
.Cells(6, i + 1).Value = .Cells(4, i + 1).Value - .Cells(5, i + 1).Value
.Cells(8, i + 1).Value = .Cells(4, i + 1).Value
If i = 1 Then
.Cells(9, i + 1).Value = .Cells(5, i + 1).Value
Else
.Cells(9, i + 1).Value = .Cells(9, i).Value + .Cells(5, i + 1).Value
End If
.Cells(10, i + 1).Value = .Cells(8, i + 1).Value - .Cells(9, i + 1).Value
End If
Next
.Cells(4, i + 1).Value = Application.Sum(.Range("E4"), .Range("I4"), .Range("M4"), .Range("Q4"))
.Cells(5, i + 1).Value = Application.Sum(.Range("E5"), .Range("I5"), .Range("M5"), .Range("Q5"))
.Cells(6, i + 1).Value = Application.Sum(.Range("E6"), .Range("I6"), .Range("M6"), .Range("Q6"))
.Cells(8, i + 1).Value = .Range("Q8").Value
.Cells(9, i + 1).Value = .Range("Q9").Value
.Cells(10, i + 1).Value = .Range("Q10").Value
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 08/11/18(火) 16:44 -
