|
こんばんは
あまりに情報が少ないので、それなりのレスしか書けないです。
「Worksheet_Activate」イベントの話しはちょっと置いといて、
「データ」というシートの1行目に項目名が有るとします。
A B C D E ・・・・IV
1 項目1 項目2 項目3
2 甲 25.33% 36.00%
3 乙 32.67% 25.84%
IV列を一時的に作業列として使用します。
C列の方が5%以上大きければ、"以上"という名のシートに転記
-5%以下であれば、"以下"という名のシートに転記します。
Sub test()
Dim cR As Range
Application.ScreenUpdating = False
With Worksheets("データ")
Set cR = .Range("IV1:IV2")
cR(2, 1).Formula = "=(C2-B2)<=-0.05"
.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=cR, _
CopyToRange:=Worksheets("以下").Range("A1:C1"), _
Unique:=False
cR(2, 1).Formula = "=(C2-B2)>=0.05"
.Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=cR, _
CopyToRange:=Worksheets("以上").Range("A1:C1"), _
Unique:=False
End With
cR.Delete xlShiftUp
Set cR = Nothing
Application.ScreenUpdating = True
End Sub
|
|