[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ある数値以下の最大値を見つけるには？』（かなえ）
[ある数値以下の最大値のセルを検索で見つけるには？]
いろいろ過去ログを見ましたが、やっぱり分かりません～。 例えば以下のように、１行目に昇順ですが連続していない数値が並んでいます。 数字は毎回不定です。 A B C D E F G･･･ 1 10 11 13 14 17 19 20 「一行目を検索値14で行方向にFindで検索しそのセルを取得」というのは分かります が、「14が無い場合は、14以下の最大値を検索しそのセルを取得」というのは VBAではどのように書けばいいでしょうか？
最大値なのでMAX関数かなぁ、と思いますが14以下のMAXを求めるにはどうすれば いいでしょうか？どうかお知恵をお貸しくださいm(__)m。
おはようございます。
二種類作ってみました。
一つは、見つからなかった時に、ForEachでループする方法
もう一つは、最初にMatchで調べてからFindする方法
Matchは見つからなかった時にもっとも近い最大値を返す特徴がありますから、
それを利用したものです。並び替わっていないと駄目ですけどね。
>昇順ですが
なので、多分いいかとは思います。
ForEachの方は総当りでみますから並び替わっていなくても大丈夫ですが、一応
並び替わってるものとして、途中でループを抜ける様にしています。
お好きな方でどうぞ。。。
Option Explicit
Sub MyMax()
Dim C As Range
Dim MyRng As Range
Dim MyMax As Range
Dim MyFind As Double, MyMin As Double
Dim Fadd As String
Set MyRng = Range("A1", Range("IV1").End(xlToLeft))
MyMin = 14
MyFind = 14
MyRng.Interior.ColorIndex = xlNone
Set C = MyRng.Find(CDbl(MyFind), , xlValues, xlWhole, xlByRows, xlNext, True)
If Not C Is Nothing Then
Fadd = C.Address
Do
Set C = MyRng.FindNext(C)
Loop Until Fadd = C.Address
MsgBox MyFind & " にヒットしました。"
C.Interior.ColorIndex = 34
Set C = Nothing
Else
MyFind = Application.WorksheetFunction.Min(MyRng)
If MyFind < 14 Then
Set MyMax = Range("A1")
For Each C In MyRng
If C.Value > MyMin Then Exit For
If MyMax.Value < C.Value Then
Set MyMax = C
End If
Next
MsgBox MyMin & "より小さい最大値は、" & MyMax.Value & "です。"
MyMax.Interior.ColorIndex = 34
Else
MsgBox MyMin & " より小さい数値はありません。"
End If
End If
Set C = Nothing
Set MyRng = Nothing
Set MyMax = Nothing
End Sub
Sub MyFind()
Dim C As Range, MyRng As Range
Dim MyFind As Double, Fadd As String
Dim x As Variant
Set MyRng = Range("A1", Range("IV1").End(xlToLeft))
MyFind = 14
x = Application.Match(MyFind, MyRng, 1)
If Not IsError(x) Then
MyFind = Cells(1, x).Value
MyRng.Interior.ColorIndex = xlNone
Set C = MyRng.Find(CDbl(MyFind), , xlValues, xlWhole, xlByRows, xlNext, True)
If Not C Is Nothing Then
Fadd = C.Address
Do
Set C = MyRng.FindNext(C)
Loop Until Fadd = C.Address
MsgBox MyFind & " にヒットしました。"
C.Interior.ColorIndex = 34
End If
Else
MsgBox MyFind & " より小さい数値はありません。"
End If
Set C = Nothing
Set MyRng = Nothing
End Sub
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0179.xls
v(=∩_∩=)v
（SoulMan）
マクロではありませんが、検索値をA2とすると、 =HLOOKUP(A2,A1:G1,1,TRUE) で、検索値以下の最大値(値そのもの)が求まります。 ※昇順に並んでいることが必須です (ちゅうねん)
SoulManさん、ちゅうねんさん早朝からありがとうございます_(._.)_！ SoulManさん、フォームも作ってくださって、感激です～！！ で、SoulManさん、もしよかったら、解説を少し加えていただけないでしょうか。 （初心者なもので･･･。） ちゅうねんさん、HLOOKUPは検索値以下の最大値しか出せないのでしょうか？ というのは、検索値以上の最小値を出す場合も実はありまして…。 （かなえ）
ざっとだけどね
v(=∩_∩=)v
（SoulMan）
Option Explicit
Sub MyMax()
'*****************************************
'変数の宣言
'*****************************************
Dim C As Range
Dim MyRng As Range
Dim MyMax As Range
Dim MyFind As Double, MyMin As Double
Dim Fadd As String
'******************************************
'データ範囲の取得
Set MyRng = Range("A1", Range("IV1").End(xlToLeft))
'***********
'初期設定
MyMin = 14
MyFind = 14
'色をクリア
MyRng.Interior.ColorIndex = xlNone
'Findの実行
Set C = MyRng.Find(MyFind, , xlValues, xlWhole, xlByRows, xlNext, True)
'ヒットしたら
If Not C Is Nothing Then
'ループ用にアドレスを記憶
Fadd = C.Address
'ループの開始
Do
Set C = MyRng.FindNext(C)
Loop Until Fadd = C.Address
'一巡したら（最初のアドレスとCのアドレスが同じになったら、、
MsgBox MyFind & " にヒットしました。"
'色を付ける
C.Interior.ColorIndex = 34
Else
'ヒットしなかったのでMyFindを範囲の最小値に変更
MyFind = Application.WorksheetFunction.Min(MyRng)
'最小値が14より小さかったら
If MyFind < 14 Then
'範囲の最左端を変数MyMaxに取得
Set MyMax = Range("A1")
'ループの開始
For Each C In MyRng
'Cが規定値「14」より大きかったらループを抜ける（これは並び替えられていることが前提）
'並び替えしないで総当りでみたいならコメントしてください。
If C.Value > MyMin Then Exit For
'少々だぶりますが、Cが「14」より小さかったら
If C.Value < 14 Then
'CがMyMaxより大きかったらMyMaxをCに更新
If MyMax.Value < C.Value Then
Set MyMax = C
End If
End If
Next
'結果を表示
MsgBox MyMin & "より小さい最大値は、" & MyMax.Value & "です。"
'色を付ける
MyMax.Interior.ColorIndex = 34
Else '最小値が14より大きかったら
MsgBox MyMin & " より小さい数値はありません。"
End If
End If
'*******************
'変数の開放
Set C = Nothing
Set MyRng = Nothing
Set MyMax = Nothing
End Sub
Sub MyFind()
'********************************
'変数の宣言
Dim C As Range, MyRng As Range
Dim MyFind As Double, Fadd As String
Dim x As Variant
'**************************************
'データ範囲の取得
Set MyRng = Range("A1", Range("IV1").End(xlToLeft))
'初期値の設定
MyFind = 14
'データ範囲の色をクリア
MyRng.Interior.ColorIndex = xlNone
'MatchでMyFindがあるか調べる
'昇順に並び替わっていることが前提
'ちなみに降順に並びかえて
'x = Application.Match(MyFind, MyRng, -1)検索方式に「-1」をセットすると
'範囲内でそれよりも大きくそれに最も近い値を返します。
x = Application.Match(MyFind, MyRng, 1)
'Matchは14がみつからなかった時に14より小さい最大値を返す。
If Not IsError(x) Then
'MyFindをMatchで検索した値に変更
MyFind = Cells(1, x).Value
'Findの実行
Set C = MyRng.Find(MyFind, , xlValues, xlWhole, xlByRows, xlNext, True)
If Not C Is Nothing Then
Fadd = C.Address
Do
Set C = MyRng.FindNext(C)
Loop Until Fadd = C.Address
MsgBox MyFind & " にヒットしました。"
C.Interior.ColorIndex = 34
End If
'範囲に14より小さい値がない場合はエラーが返るのでMatchのエラーで判断
Else
MsgBox MyFind & " より小さい数値はありません。"
End If
'******************
'変数の開放
Set C = Nothing
Set MyRng = Nothing
End Sub
SoulManさん、何度もお返事くださってありがとうございます！そして何度もお願いして スミマセン(__)。。。 > For Each C In MyRng > 'Cが規定値「14」より大きかったらループを抜ける（これは並び替えられている > ことが前提） > '並び替えしないで総当りでみたいならコメントしてください。 この並べ替えしない時のバージョンをぜひ教えてください！(かなえ)
うん？
'並び替えしないで総当りでみたいならコメントしてください。
If C.Value > MyMin Then Exit For
だから、
'If C.Value > MyMin Then Exit For
で、いいと思いますよ。
つまり、最後までループするわけです。
多分、直したと思うけど、コメントをつけた方のコードにしてくださいね。
v(=∩_∩=)v
（SoulMan）
あ、そうだったんですねー(*^_^*) 細かいところまで解説ありがとうございました。これを応用していけたらと思います。 最後まで面倒見てくださってありがとうございました(^o^)丿（かなえ）
今さらですが、ちゅうねんさん の代わりに、関数式Ver.での求め方です。 1行目に昇順で並んでいるという事なので、A2に基準値がある場合には、 基準値以下の最大値は、（ちゅうねんさんとは別案です。最小値との考え方の統一上） =LOOKUP(A2,A1:G1) あるいは、 =MAX(IF(A1:G1>A2,MIN(A1:G1),A1:G1)) Ctrl+Shift+Enterで配列数式として確定。
基準値以上の最小値は、 =IF(A2=LOOKUP(A2,A1:G1),A2,INDIRECT(ADDRESS(1,MATCH(LOOKUP(A2,A1:G1),A1:G1,FALSE)+1))) あるいは、 =MIN(IF(A1:G1<A2,MAX(A1:G1),A1:G1)) Ctrl+Shift+Enterで配列数式として確定。 で、求められます。 配列式の =MAX(***** や =MIN(***** は、元データが昇順に並んでいなくても求められます。 (sin)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.