こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

最小値(最大値)を探す

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

投稿日時 - 2002-06-17 23:37:14

QNo.294294

すぐに回答ほしいです

質問者が選んだベストアンサー

途中から書いていますが、下の部分を置き換えて下さい。
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

投稿日時 - 2002-06-20 15:44:08

お礼

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

投稿日時 - 2002-06-20 18:46:59

ANo.9

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(9)

ANo.8

少し長くなりました。

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

また、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

投稿日時 - 2002-06-19 13:56:42

補足

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

投稿日時 - 2002-06-19 23:57:06

ANo.7

日付は数値に連動するようにしてみました。
一番最初、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

投稿日時 - 2002-06-19 00:05:03

補足

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

投稿日時 - 2002-06-19 10:34:10

ANo.6

補足について、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

投稿日時 - 2002-06-18 19:18:31

補足

日付についてお願いします。日付は、最小値(最大値)の日付をそのまま表示するようにお願いします。つまり、最小値(最大値)データーの左側の日付をそのまま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とするには
よろしくお願いします。

投稿日時 - 2002-06-18 20:14:08

ANo.5

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

投稿日時 - 2002-06-18 06:43:41

ANo.4

質問の意味を理解しきれていない気がしますが、下の算式ではダメなわけですよね。
 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

投稿日時 - 2002-06-18 05:55:36

補足

どうもありがとうございました。追加お願いします。もう少し詳しく書きますと、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の日付も同じようするにはどうすればいいのですか?よろしくお願いします。

投稿日時 - 2002-06-18 14:15:07

ANo.3

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

投稿日時 - 2002-06-18 00:32:53

ANo.2

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

投稿日時 - 2002-06-18 00:04:00

ANo.1

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

参考URL:http://members.tripod.co.jp/tatuken/EXCEL_MAIN.htm

投稿日時 - 2002-06-17 23:42:40

あなたにオススメの質問