最小値（最大値）を探す

質問

セルB2～B16及びD3～D20中でセルF5の値より小さければその値をF5に書き込むには！！
また、セルF7の値より大きければその値をF7に書き込むには！！
関数で出来なければ、VBAでよろしくお願いします。
こちらのアプリケーションは、エクセル２０００です。

回答No.9

nishi6 · ベストアンサー

途中から書いていますが、下の部分を置き換えて下さい。
A2に入力した時に連続日付のセットは問題なくできますが、この時、数値部分をクリアしないと、最大値・最小値の判定結果に影響が出るかもしれないので数値部分をクリアしています。

　　'日付、数値入力範囲に変更があったら（この行の下から差し替え）
　　If Target.Address(0, 0) = "A2" Then
　　　　If MsgBox("入力値をクリアし、連続日付をセットしますか？", vbOKCancel) = vbOK Then
　　　　　　chkAreaNum.ClearContents '数値部分をクリア
　　　　　　Target.AutoFill Destination:=Range("A2:A16")
　　　　　　Range("C3") = Range("A16") + 1
　　　　　　Range("C3").AutoFill Destination:=Range("C3:C20")
　　　　End If
　　End If

　　If Not Intersect(Target, chkAreaAll) Is Nothing Then
　　　　For Each rg In chkAreaNum
　　　　　　'最小値、最大値を調べる
　　　　　　If rg <> "" Then
　　　　　　　　If IsNumeric(rg) And Val(rg) <= Val(Range("F5")) Then '最小値
　　　　　　　　　　If rg.Offset(0, -1) <> "" Then
　　　　　　　　　　　　Range("F5") = rg
　　　　　　　　　　　　Range("E5") = rg.Offset(0, -1)
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　If Val(rg) >= Val(Range("F7")) Then '最大値
　　　　　　　　　　If rg.Offset(0, -1) <> "" Then
　　　　　　　　　　　　Range("F7") = rg
　　　　　　　　　　　　Range("E7") = rg.Offset(0, -1)
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End If
　　Application.EnableEvents = True

　　Exit Sub
ErrorHandler:
　　Application.EnableEvents = True
End Sub

お礼

本当に何回も追加してすみませんでした。コメントまで表示が出ておまけにデーターまで削除出来るようにしてくださって大変たすかりました。おかげで自分で思った以上の表が出来ました。どうもありがとうございました。・・・・・・・カズミ

回答No.8

nishi6

少し長くなりました。

消去した時や、修正した時にどう判定するかは、日付と数値入力が決まり通りに入力されている事が前提になります。
下は入力値の型チェックを追加しています。

また、Excelの性質（仕様？）で、数値と文字の比較が可能、日付は数値、未入力セルの数値としての値はゼロなどがあり、コードが長くなっています。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim chkAreaAll As Range '最小値、最大値を調べる範囲(全部)
　　Dim chkAreaDay As Range '最小値、最大値を調べる範囲(日付)
　　Dim chkAreaNum As Range '最小値、最大値を調べる範囲(数値)
　　Dim rg As Range

　　Set chkAreaDay = Union(Range("A2:A16"), Range("C3:C20"))
　　Set chkAreaNum = Union(Range("B2:B16"), Range("D3:D20"))
　　Set chkAreaAll = Union(chkAreaDay, chkAreaNum)

　　On Error GoTo ErrorHandler

　　'日付入力範囲の入力値は日付か
　　If Not Intersect(Target, chkAreaDay) Is Nothing Then
　　　　If Target <> "" And Not IsDate(Target) Then
　　　　　　MsgBox "入力は日付形式のみです。"
　　　　　　Target.Select
　　　　　　Exit Sub
　　　　End If
　　End If
　　'数値入力範囲の入力値は数値か
　　If Not Intersect(Target, chkAreaNum) Is Nothing Then
　　　　If Target <> "" And Not IsNumeric(Target) Then
　　　　　　MsgBox "入力は数値形式のみです。"
　　　　　　Target.Select
　　　　　　Exit Sub
　　　　End If
　　End If

　　Application.EnableEvents = False '再度イベントが発生するのを止める

　　'日付、数値入力範囲に変更があったら
　　If Not Intersect(Target, chkAreaAll) Is Nothing Then
　　　　For Each rg In chkAreaNum
　　　　　　'最小値、最大値を調べる
　　　　　　If rg <> "" Then
　　　　　　　　If IsNumeric(rg) And Val(rg) <= Val(Range("F5")) Then '最小値
　　　　　　　　　　Range("F5") = rg
　　　　　　　　　　If rg.Offset(0, -1) <> "" Then Range("E5") = rg.Offset(0, -1)
　　　　　　　　End If
　　　　　　　　If Val(rg) >= Val(Range("F7")) Then '最大値
　　　　　　　　　　Range("F7") = rg
　　　　　　　　　　If rg.Offset(0, -1) <> "" Then Range("E7") = rg.Offset(0, -1)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End If
　　Application.EnableEvents = True

　　Exit Sub
ErrorHandler:
　　Application.EnableEvents = True
End Sub

補足

本当に無理いってすみませんでした。どうもありがとうございました。うまくいきました。
もう一つ追加お願いします。日付ですが、A2に6/1と入れA3にA２+1でA16までコピー及びC3にA16+1・C4にC3+1でC20までコピーすでばいいのですが、VBAでよろしくお願いします。(間違って計算式を消したらまた書かなくてはならない為。VBAならそんなことが起こらないから）

回答No.7

nishi6

日付は数値に連動するようにしてみました。
一番最初、F5、F7にはダミー数値を入れておいて開始します。
通常、最小値(F5)には大きい数値、最大値(F7)には小さい数値です。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim chkAreaAll As Range '最小値、最大値を調べる範囲(全部)
　　Dim chkAreaDay As Range '最小値、最大値を調べる範囲(日付)
　　Dim chkAreaNum As Range '最小値、最大値を調べる範囲(数値)
　　Dim rg As Range

　　Set chkAreaDay = Union(Range("A2:A16"), Range("C3:C20"))
　　Set chkAreaNum = Union(Range("B2:B16"), Range("D3:D20"))
　　Set chkAreaAll = Union(chkAreaDay, chkAreaNum)

　　On Error GoTo ErrorHandler

　　Application.EnableEvents = False '再度イベントが発生するのを止める

　　'日付、数値入力範囲に変更があったら
　　If Not Intersect(Target, chkAreaAll) Is Nothing Then
　　　　For Each rg In chkAreaNum
　　　　　　'最小値、最大値を調べる
　　　　　　If rg <> "" Then
　　　　　　　　If rg <= Range("F5") Then '最小値
　　　　　　　　　　Range("F5") = rg
　　　　　　　　　　Range("E5") = rg.Offset(0, -1)
　　　　　　　　End If
　　　　　　　　If rg >= Range("F7") Then '最大値
　　　　　　　　　　Range("F7") = rg
　　　　　　　　　　Range("E7") = rg.Offset(0, -1)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End If
　　Application.EnableEvents = True

　　Exit Sub
ErrorHandler:
　　Application.EnableEvents = True
End Sub

補足

無理いってすみませんがお願いします。B列とD列のデーターを消してもF5とF7のデーターは保持していますが、A列とC列の日付を消すとE5とE7の日付が消えてしまいます。A列とC列の日付を消しても、E5とE7の日付が保持するようにお願いします。

回答No.6

nishi6

補足について、VBA部分を追記、変更してみました。
まだ主旨が理解できていないと思います。日付とデータはそれぞれで最大値・最小値を求めています。

個人的には、数値の最大値・最小値に対応する日付が必要？とも思いますが、補足に『日付も同じようするには・・・』とあるので、日付とデータは無関係に最大値・最小値を求めています。違っていれば補足して下さい。

※日付、データの範囲には一ヶ月単位くらいで入力し、過去の最大値・最小値を表示している雰囲気でしょうか。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim chkAreaAll As Range '最小値、最大値を調べる範囲(全部)
　　Dim chkAreaDay As Range '最小値、最大値を調べる範囲(日付)
　　Dim chkAreaNum As Range '最小値、最大値を調べる範囲(数値)

　　Set chkAreaDay = Union(Range("A2:A16"), Range("C3:C20"))
　　Set chkAreaNum = Union(Range("B2:B16"), Range("D3:D20"))
　　Set chkAreaAll = Union(chkAreaDay, chkAreaNum)

　　On Error GoTo ErrorHandler

　　Application.EnableEvents = False '再度イベントが発生するのを止める
　　'最小値、最大値を調べる
　　If Not Intersect(Target, chkAreaAll) Is Nothing Then
　　　　'日付
　　　　Range("E5") = Application.Min(chkAreaDay, Range("E5"))
　　　　Range("E7") = Application.Max(chkAreaDay, Range("E7"))
　　　　'数値
　　　　Range("F5") = Application.Min(chkAreaNum, Range("F5"))
　　　　Range("F7") = Application.Max(chkAreaNum, Range("F7"))
　　End If
　　Application.EnableEvents = True

　　Exit Sub
ErrorHandler:
　　Application.EnableEvents = True
End Sub

補足

日付についてお願いします。日付は、最小値(最大値)の日付をそのまま表示するようにお願いします。つまり、最小値(最大値)データーの左側の日付をそのままE5(E7)にコピーします。また、A2～D20までのデーターが変わってもF5とF7のデーターが更新しない限りE5とE7もそのままの状態です。F5とF7が更新した時は、E5とE7の日付はF5とF7の左側の日付に更新します。　例、E5＝5/1・F5＝123その時データーA2～D20までの中で最小値が103で、103のデーターの左側の日付が5/12その時セルE5＝5/12・セルE7＝103とするには
よろしくお願いします。

回答No.5

imogasi

既に解答が出てから言うのもおかしいのですが、質問の意味が不明です。私の頭が悪いのでしょうか。
Ｂ２からＢ１６の各セルに数値が入っている。従って複数個の数値を対象にしているわけです。一方セルＦ５には１つの数値が入っている。「セルF5の値より小さければ」であれば、小さい数値は複数個ある可能性があります。その値をF5セル１個の「セルに書き込む」ことはそもそも
出来ない相談ではないですか。表題には「最小値を探す」と有りますが、質問と内容が違っているのでは。「Ｂ２からＢ１６までの数値の最小値を求める」というのであれば、質問は出ないとおもいますので。

回答No.4

nishi6

質問の意味を理解しきれていない気がしますが、下の算式ではダメなわけですよね。
　F5 =IF(COUNT($B$2:$B$16,$D$3:$D$20)>0,MIN($B$2:$B$16,$D$3:$D$20),"")
　F7 =IF(COUNT($B$2:$B$16,$D$3:$D$20)>0,MAX($B$2:$B$16,$D$3:$D$20),"")

最初、F5、F7に任意の数値を入力しておく場合は上の算式は当然つかえなくなります。
この場合はコードを書くしかないでしょう。
B2:B16、D3:D20に入力したら最小値、最大値を調べています。

ここから（入力するシートのコードウインドウに貼り付けます）
↓
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim checkArea As Range '最小値、最大値を調べる範囲
　　Set checkArea = Union(Range("B2:B16"), Range("D3:D20"))

　　On Error GoTo ErrorHandler

　　Application.EnableEvents = False '再度イベントが発生するのを止める
　　'最小値、最大値を調べる
　　If Not Intersect(Target, checkArea) Is Nothing Then
　　　　Range("F5") = Application.Min(checkArea, Range("F5"))
　　　　Range("F7") = Application.Max(checkArea, Range("F7"))
　　End If
　　Application.EnableEvents = True

　　Exit Sub
ErrorHandler:
　　Application.EnableEvents = True
End Sub

補足

どうもありがとうございました。追加お願いします。もう少し詳しく書きますと、A2～A16とC3～C20には日付が入っています。B2～B16とD3～D20データー（数字）が入っています。E5とE7は日付F5とF7はデーターです。E5とE7およびF5とF7には日付とデーターが入っている時、B2～B16とD3～D20の最小値をF5と比較し小さければF5に書き換える。また、B2～B16とD3～D20の最大値をF7と比較し大きければF7に書き換える。ここまでは、OKです。E5とE7の日付も同じようするにはどうすればいいのですか？よろしくお願いします。

回答No.3

Black

No.1のものです。
F5に書き込むという箇所を勘違いしていました。
関数ではできません。
すみませんでした。
VBAで出来ると思います。申し訳ありませんでした。

回答No.2

wogota

VBAを使うのならば、このような感じになります。手元にExcelがありませんので
確認していません。（業務での使用でして個人所有していないので・・・）

Dim i as Integer, j as Integer
Dim valF5 as Integer, valF7 as Integer
Dim minVal( 2 to 3) as Integer, maxVal( 2 to 3) as Integer

minVal( 2)= 2
maxVal( 2)= 16
minVal( 3)= 3
maxVal( 3)= 20

valF5= Cells( 5, 6).value
valF7= Cells( 7, 6).value

For i= 2 to 3
　For j= minVal( i) to maxVal( i)
　　If Cells( j, i).value< valF5 Then
　　　Cells( j, i).value= valF5
　　Else if Cells( j, i).value> valF7 Then
　　　　Cells( j, i).value= valF7
　　　End If
　　End If
　Next j
Next i

回答No.1

Black

LOOKUP関数の中にIF関数で条件を付ければ出来ると思います。

参考URL：

http://members.tripod.co.jp/tatuken/EXCEL_MAIN.htm