エクセル マクロ 範囲の最大最少を消去

こんにちは、エクセルのマクロで教えて頂けませんか？

画像のように１１行から下行に数値が並んでいます。

その中の最大値、最小値を一撃で消去する方法はあるでしょうか？

もし、最大値が二つあったらどちらでもよいのでひとつ消去すると言う事でよいです。
（最小値も同じ）

もし、コードが多くなる場合は列の指定方法と行の範囲の指定方法を教えていただければ嬉しいです。

詳しい方、よろしくお願いいたします。

No.4 ベストアンサー 回答者： tom04 回答日時： 2015/11/20 22:41

No.1・3です。

あ～～～そういうコトですかぁ～！

B11セル以降に数値データが5個以上あったときにマクロが実行されればよいのですね？
その時に最大値・最小値を一つずつ消去すれば良い！というコトだとすると
↓のコードにしてみてください。

Sub Sample3()
Dim lastRow As Long, myArea As Range
Dim c As Range, myMax, myMin
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
If lastRow > 10 Then
Set myArea = Range(Cells(11, "B"), Cells(lastRow, "B"))
If WorksheetFunction.Count(myArea) > 4 Then '範囲内に数値データが5以上の場合//
myMax = WorksheetFunction.Max(myArea)
myMin = WorksheetFunction.Min(myArea)
Set c = myArea.Find(what:=myMax, LookIn:=xlValues, lookat:=xlWhole)
c.ClearContents
Set c = myArea.Find(what:=myMin, LookIn:=xlValues, lookat:=xlWhole)
c.ClearContents
End If
End If
End Sub

※　今回も最初に出現する「最大値」・「最小値」のみを消去するようにしています。

今度はどうでしょうか？m(_ _)m

この回答へのお礼

再々度の回答ありがとうございます。

その通りです！　お陰様でばっちりできました！

教えて頂き、感謝いたします。

ありがとうございました！

お礼日時：2015/11/21 00:27

No.3 回答者： tom04 回答日時： 2015/11/20 19:03

No.1です。

＞５個以上のデータの時のみ実行するとできますでしょうか？

＞併せて、最大値、最小値すべてではなく、同値があっても消去するのは最大値１個、最小値１個とするのはどうすればよいでしょうか。

すなわち最大値・最小値とも5個以上あった場合、その一つだけを消去！
という解釈でよい訳ですね？
最初に出現した「最大値」・「最小値」を消去するようにしてみました。

Sub Sample2()
Dim lastRow As Long, myArea As Range
Dim c As Range, myMax, myMin
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
If lastRow > 10 Then
Set myArea = Range(Cells(11, "B"), Cells(lastRow, "B"))
myMax = WorksheetFunction.Max(myArea)
myMin = WorksheetFunction.Min(myArea)
If WorksheetFunction.CountIf(myArea, myMax) > 4 Then
Set c = myArea.Find(what:=myMax, LookIn:=xlValues, lookat:=xlWhole)
c.ClearContents
End If
On Error Resume Next '←念のため//
If WorksheetFunction.CountIf(myArea, myMin) > 4 Then
Set c = myArea.Find(what:=myMin, LookIn:=xlValues, lookat:=xlWhole)
c.ClearContents
End If
End If
End Sub

※　最大値・最小値とも4個以下の場合は
何も変化しません。m(_ _)m

この回答へのお礼

再回答ありがとうございます。

言葉たらずになってしまい申し訳ありません。

最大値、最小値が5個以上では無くて、数値が範囲内に5個以上あった時に処理を行い、最大値、最小値は二つ以上あってもそれぞれ一つだけ消去すると言う意味でした。

お手数をおかけして申し訳ありませんが、教えて頂けませんでしょうか。

よろしくお願いいたします。

お礼日時：2015/11/20 19:08

No.2 回答者： CoalTar 回答日時： 2015/11/20 17:45

ほとんど数式ですが、

'空白セルや数値でない場合の対処はしていません
Sub Macro1()
　 Dim z As Long
　 z = Range("B" & Rows.Count).End(xlUp).Row
　 If z <= 15 Then Exit Sub
　
　 Columns("C:C").Insert Shift:=xlToRight
　 Range("C11").FormulaR1C1 = _
　 　 "=IF(MAX(R11C2:R" & z & "C2)=RC[-1],""最大値"",IF(MIN(R11C2:R" & z & "C2)=RC[-1],""最小値"",RC[-1]))"
　 Range("C12:C" & z).FormulaR1C1 = _
　 　 "=IF(ISNUMBER(MATCH(""最大値"",R11C3:R[-1]C,0)),RC[-1],IF(MAX(R11C2:R" & z & "C2)=RC[-1],""最大値""," & Chr(10) & _
　 　 "IF(ISNUMBER(MATCH(""最小値"",R11C3:R[-1]C,0)),RC[-1],IF(MIN(R11C2:R" & z & "C2)=RC[-1],""最小値"",RC[-1]))))"

　 With Range("C11:C" & z).Offset(, -1)
　 　 .Value = .Offset(, 1).Value
　 　 .Replace What:="最大値", Replacement:=""
　 　 .Replace What:="最小値", Replacement:=""
　 End With
　 Columns("C:C").Delete Shift:=xlToLeft
End Sub

この回答へのお礼

回答ありがとうございます。
お陰様で無事消去できました。

教えて頂き、ありがとうございました。

お礼日時：2015/11/21 00:26

No.1 回答者： tom04 回答日時： 2015/11/19 16:45

こんにちは！

画像ではB列になっていますので、B列限定ですが、

Sub Sample1()
Dim lastRow As Long, myArea As Range, myMax, myMin
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
If lastRow > 10 Then
Set myArea = Range(Cells(11, "B"), Cells(lastRow, "B"))
myMax = WorksheetFunction.Max(myArea)
myMin = WorksheetFunction.Min(myArea)
With myArea
.Replace what:=myMax, replacement:="", lookat:=xlWhole
.Replace what:=myMin, replacement:="", lookat:=xlWhole
End With
End If
End Sub

※　最大値・最小値をすべて消去しています。m(_ _)m

この回答へのお礼

回答ありがとうございます。

さすがですね、何でも一発で解消するのは見ていて気持ちが良いです。

それで２点ほど、教えていただきたいのですが、データが１個だけの時も消去すると思いますが、５個以上のデータの時のみ実行するとできますでしょうか？

併せて、最大値、最小値すべてではなく、同値があっても消去するのは最大値１個、最小値１個とするのはどうすればよいでしょうか。

お手数をおかけして申し訳ありませんが、教えていただけませんでしょうか。

よろしくお願いいたします。

お礼日時：2015/11/19 23:51