| |
γ さんのコードを参考にしたら無事動きました。
本当にありがとうございます。
ただ、エラー値が多いと完了まで5分ぐらいかかってしまいます。
もし、時間短縮の手法についてご存知でしたら、教えていただけるとありがたいです。
↓今回作成したマクロ
---------------------------------------------------
Sub エラー値検出()
'
' エラー値検出 Macro
'
Dim dic As Object
Dim lRow As Long
Dim izRange As Range
Dim izmax As Double
Dim izmin As Double
Dim iz As Double
Dim z As Variant '←型の不一致エラーのためVariantに変更
Dim i As Long
Worksheets("Sheet1").Activate
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Set dic = CreateObject("Scripting.Dictionary")
'基準値の作成
Set izRange = Range(Cells(26, 5), Cells(Rows.Count, 5).End(xlUp))
izmax = Application.WorksheetFunction.Max(izRange)
izmin = Application.WorksheetFunction.Min(izRange)
iz = izmin + ((izmax - izmin) / 3)
Application.ScreenUpdating = False
'x座標番号が1 かつ z座標が基準値を超えていたら、
'対応するy座標番号 を Dictionaryに保存
For i = 2 To lRow
z = Cells(i, 5).Value
If z > iz And Cells(i, 1).Value = 1 Then
dic(Cells(i, 2).Value) = Empty
End If
Next
'そのy座標番号のデータをすべて削除する
For i = lRow To 2 Step -1
If dic.Exists(Cells(i, 2).Value) Then
Rows(i).Delete
''Cells(i, 6).Value = 1
End If
Next
Application.ScreenUpdating = True
'
End Sub
|
|
argon
- 13/7/23(火) 22:03 -
