列の数値群の数値の抽出方法（ＶＢＡ）

質問

エクセルＶＢＡでお願いします。
今、Ｂ列にRange(Cells(3,2),Cells(I.2))の範囲にランダムな実数値が
格納されているとします。（Ｉは変数）
この数値群から、正の実数で最小値、または負の実数で最大値を抽出したいのですが、どのようなコードを組めばよいでしょうか。
数値群は大小順ではなくランダムに並んでいるとします。お願いいたします。数値群の数は約２００００個あります。

回答No.3

onlyrom · ベストアンサー

オーソドックスにやるなら先ずデータ全てを配列に入れたあと
ForとかDo Loopで回しながら比較、という感じでしょうが

正、負でオートフィルターをかけた後、ワークシート関数のMax,Minを使う方法もあるということで。。

（条件）
Ｂ２に必ず見出し（適当でいい）があること
データの範囲は、Ｂ３～～任意の行までとする

'--------------------------------------------
Sub Test()

　Dim MaxValue As Double
　Dim MinValue As Double
　Dim LastRow As Long
　Dim myRange As Range

Application.ScreenUpdating = False

　LastRow = Cells(Rows.Count, "B").Row
　Set myRange = Range(Cells(2, "B"), Cells(LastRow, "B"))

　myRange.AutoFilter Field:=1, Criteria1:=">=0", Operator:=xlAnd
　MinValue = WorksheetFunction.Min(myRange.SpecialCells(xlCellTypeVisible))

　myRange.AutoFilter Field:=1, Criteria1:="<0", Operator:=xlAnd
　MaxValue = WorksheetFunction.Max(myRange.SpecialCells(xlCellTypeVisible))

　myRange.AutoFilter

　MsgBox "最小値：　" & MinValue & vbLf & "最大値：　" & MaxValue

Application.ScreenUpdating = True

End Sub
'---------------------------------------------

（データ）
－２００　■最大値
５５５５
－３００
２２２２　●最小値
－５００
３３３３

上記のデータなら、最小値：２２２２　最大値；－２００　を取得します。
以上。

お礼

ありがとうございます。助かります。次の方の求め方をみても、いろいろ
あるのですね。お礼の点付けに悩みます。返信の速度優先とさせて頂きます。

回答No.4

Wendy02

こんばんは。

本当には、以下の文章の意味が良く分からないです。
>正の実数で最小値、または負の実数で最大値を抽出したいのですが、

正の実数で最小値、　-> 0より以上で、最小値ということかな？
負の実数で最大値　　-> 0より以下で、最大値ということかな？

抽出？

同じものを、やり方を変えて作ってみました。
ただし、両方とも「0」を抜きました。2番は、VBらしく作りました。
もしも、0を入れるなら、片方の不等号の記号を変更すればよいです。

Sub Test1()
Dim mMin As Variant
Dim mMax As Variant
Dim rng As Range
　 Set rng = Range("B3", Range("B65536").End(xlUp))
　 mMin = Evaluate("MIN(IF(" & rng.Address & "<=0,""""," & rng.Address & "))")
　 mMax = Evaluate("MAX(IF(" & rng.Address & ">=0,""""," & rng.Address & "))")
　 Set rng = Nothing
　 MsgBox "最小値: " & mMin & vbNewLine & "最大値:　" & mMax

End Sub
'--------------------------------------------
Sub Test2()
　　Dim mMin As Variant
　　Dim mMax As Variant
　　Dim rng As Range
　　Dim c As Variant
　　mMin = Empty
　　mMax = Empty
　　Set rng = Range("B3", Range("B65536").End(xlUp))
　　For Each c In rng
　　　　If c.Value > 0 Then
　　　　　　If IsEmpty(mMin) Then
　　　　　　　　mMin = c.Value
　　　　　　ElseIf c.Value < mMin Then
　　　　　　　　mMin = c.Value
　　　　　　End If
　　　　ElseIf c.Value < 0 Then
　　　　　　If IsEmpty(mMax) Then
　　　　　　　　mMax = c.Value
　　　　　　ElseIf c.Value > mMax Then
　　　　　　　　mMax = c.Value
　　　　　　End If
　　　　End If
　　Next c
　　Set rng = Nothing
　　MsgBox "最小値: " & mMin & vbNewLine & "最大値:　" & mMax

End Sub

お礼

ありがとうございます。ご提示いただいた案をじっくり調べてマスターしたいと思います。特に第一案。繰返し処理のなかで使うのでコードが短いのは大きな魅力です。お礼は回答順とさせて頂きますが、動作すれば多分、第一案
を使いたいと思います。

回答No.2

某HN クロメート(Chromate)（@CoalTar）

☆参考まで(無視してもかまいません)
1. [Ctrl]+[F3]名前の定義
　　　名前 : 対象
　参照範囲 : =$B$3:$B$65536
2. [Ctrl]+[F3]名前の定義
　　　名前 : 桜
　参照範囲 : =$B$3:INDEX($B:$B,COUNT(対象)+2)
3. 希望の値を求める数式
　　　=LARGE(桜,MAX(COUNTIF(桜,">=0"),1))

抽出はオートフィルタ か フィルタオプションかな

補足

ありがとうございます。エクセルＶＢＡで考えたいと思います。

回答No.1

mitarashi

配列にいれて、quick sortするのはいかがでしょうか。負の実数も存在して無視したいなら、配列に転記する時に行えば良いと思います。
http://www5d.biglobe.ne.jp/~tomoya03/shtml/algorithm/QSort.htm
http://japan.internet.com/column/developer/20080418/26.html

補足

ありがとうございます。配列に入れて関数で処理することを考えていました。例えば下記
Dim S As Worksheet
Dim NumA As Variant, NumB As Variant
Dim Kmin As Double,Kmax As Double
Dim I as Integer,Im As Integer,Iq As Integer
Set S = Worksheets("Sheet1")
Iq = 1
If Cells(Iq, 2) > 0 Then
-----------------
Next Iq
NumA = S.Cells(1).Resize(I).Value
Kmin=Application.MIN(Range(Cells(1,2),Cells(I,2)))
Else
------------------
NEXT Im
　　NumB = S.Cells(1).Resize(Im).Value
Kmax=Application.MAX(Range(Cells(1,2),Cells(Im,2)))
End IF
　　IF　Cells(I, 2) ＝ 0 Then　
　　以下　略
ここで　-----------の行で条件に合致したセルの中味をNumA,NumBに追加する方法(コード）が不明なのです。
（可能かどうかを含めて）関数処理で求める方法を知りたいのです。
空白のセルにいれることはNGで、あくまでもVBAのコードで求めたいのです。