エラー値を除く最大値を求めるには

質問

ＶＢＡ初心者です。

　1
　3
　4
#DIV/0!
　5
　0
#DIV/0!
　8

上記の列を指定してエラー値を除く上位3位の値を取りたいと思ってます
ＶＢＡマクロでやるにはどうしたらいいでしょうか
調べましたがわかりませんでした教えてください。

回答No.4

merlionXX

ではVBAの一例です。
一旦配列に取り込み、大きい方から1～3位を表示します。

Sub test01()
Dim myAr()
Dim n As Long, i As Integer
For Each c In Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) 'A列の各データが
If Not IsError(c.Value) Then 'エラーでなければ
ReDim Preserve myAr(n) '配列に取り込む
myAr(n) = c.Value
n = n + 1
End If
Next c
For i = 1 To 3
MsgBox i & "位：" & Application.Large(myAr, i)
Next i
End Sub

回答No.3

rukuku

＃１のrukukuです

別解です。
「降順で並べ替え」を行うと、以下のようになります。
#DIV/0!
#DIV/0!
8
7
4
3
1
0
エラーの部分を除いて「上から３つ」取ればOKです。

実際のプログラムの例を以下に示します。
Macro1を実行し後、Macro2を実行してください。
Macro1は「マクロの記録」を使用しただけなので、効率の悪いコードになっていますがご容赦ください。

Sub Macro1()

Columns("A:A").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End Sub

Sub Macro2()
Dim Line
Dim i
Dim Max(3)
Sheets("Sheet2").Select

For Line = 2 To [A2].End(xlDown).Row
If Not IsError(Cells(Line, "A")) Then
i = i + 1
Max(i) = Cells(Line, "A")
End If
If i = 3 Then Exit For
Next Line

MsgBox Max(1) & Chr(13) & Max(2) & Chr(13) & Max(3)

End Sub

お礼

お礼遅くなってすいません
とても詳しく教えていただきまして有難うございます。
うまくできました！！
感謝感謝します。

回答No.2

rukuku

訂正です

「重複がある場合」で
×：=IF(ISNA(G3),I2,G3)
○：=IF(ISNA(G3),H2,G3)
です。

回答No.1

rukuku

はじめまして

＞ＶＢＡ初心者です。
EXCELのVBAと想定して回答します。
(WordやAccessにもVBAがありますので)

重複がなければ、
質問の値がA2から順に下に入っているとして、
C2に
=RANK(D2,D:D)
D2に
=IF(ISERROR(A2),"",A2)
以下、データが入っているオートフィル

F2→1
F3→2
F4→3
としておいて
G2に
=VLOOKUP(F2,$C$2:$D$9,2,FALSE)
以下G4までオートフィルでできます。

重複がある場合にはさらに、
H2に
=G2
H3に
=IF(ISNA(G3),I2,G3)
で、H3をH4にオートフィルです。

関数だけでできてしまいましたが、「マクロ」というならば、この関数をマクロで入力すればOKです。