|
こんな感じになりませんか?参考にしてください。
Sub test()
Dim dic As Object
Dim lastRow As Long
Dim myRange As Range
Dim myMax As Double, myMin As Double
Dim target As Double
Dim v As Double
Dim k As Long
Set dic = CreateObject("Scripting.Dictionary")
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'基準値の作成
Set myRange = Range(Cells(2, 5), Cells(Rows.Count, 5).End(xlUp))
myMax = Application.WorksheetFunction.Max(myRange)
myMin = Application.WorksheetFunction.Min(myRange)
target = myMin + (myMax - myMin) * 2 / 3
'x座標番号が1 かつ z座標が基準値を超えていたら、
'対応するy座標番号 を Dictionaryに保存
For k = 2 To lastRow
v = Cells(k, 5).Value
If Cells(k, 1).Value = 1 And v > target Then
dic(Cells(k, 2).Value) = Empty
End If
Next
'そのy座標番号のデータをすべて削除する
For k = lastRow To 2 Step -1
If dic.Exists(Cells(k, 2).Value) Then
'' Rows(k).Delete
Cells(k, 6).Value = 1
End If
Next
End Sub
|
|