Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7763 / 76734 ←次へ | 前へ→

【74556】Re:マクロを用いたエラー値の削除
発言  argon  - 13/7/23(火) 22:03 -

引用なし
パスワード
   γ さんのコードを参考にしたら無事動きました。

本当にありがとうございます。

ただ、エラー値が多いと完了まで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

8 hits

【74535】マクロを用いたエラー値の削除 argon 13/7/18(木) 19:58 質問
【74539】Re:マクロを用いたエラー値の削除 γ 13/7/19(金) 8:45 発言
【74540】Re:マクロを用いたエラー値の削除 γ 13/7/19(金) 23:47 発言
【74550】Re:マクロを用いたエラー値の削除 argon 13/7/21(日) 23:49 回答
【74551】Re:マクロを用いたエラー値の削除 γ 13/7/22(月) 20:05 発言
【74556】Re:マクロを用いたエラー値の削除 argon 13/7/23(火) 22:03 発言
【74559】Re:マクロを用いたエラー値の削除 γ 13/7/24(水) 8:10 発言

7763 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free