|
ありがとうございました。自分だけではなかなか解決できなくて困っていました。自己流で作った文は次のように活用させて頂きました。
Sub 抽出月()
Range("B7:R35").Select
Selection.ClearContents
Range("r4").Select
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Range("T6:Z400").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("GG1:GI2"), _
Unique:=True
Range("T6:Z400").Copy
Range("B6").PasteSpecial Paste:=xlPasteValues
ActiveSheet.ShowAllData
Range("B6:I35").Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlYes
終行 = Range("b35").End(xlUp).Row
For k = 7 To 終行
Range("i7:i" & k & "").Formula = "=Sum(E7:H7)"
Range("n7:n" & k & "").Value = Array("=ROUNDdown(E7/D7,1)")
Range("o7:o" & k & "").Value = Array("=ROUNDdown(F7/D7,1)")
Range("p7:p" & k & "").Value = Array("=ROUNDdown(G7/D7,1)")
Range("q7:q" & k & "").Value = Array("=ROUNDdown(H7/D7,1)")
Range("r7:r" & k & "").Value = Array("=ROUNDdown(I7/D7,1)")
Range("b" & 終行 + 1 & ":i35") = ClearContents
Range("K" & 終行 + 1 & ":R35") = ClearContents
Range("b7", "d" & k & "").Copy
Range("k7").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("r4").Select
Next k
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True
End Sub
|
|