vbaの繰り返しで求める最大値について

Question

900人程の身長のデータから、2番目に大き身長をセルに表示させたいのですがどうすれば良いでしょうか？

for文を使ったプログラミングです！

どなたか教えて頂けますでしょうか？




ちなみに下は一番小さい身長のデータを表示するプログラミングです。
Sub task1()

 Dim Hmin As Double
 Dim i As Long
 
 Hmin = Cells(6, 11)
 For i = 1 To 912
    If Cells(i + 1, 7) < Hmin Then
    Hmin = Cells(i + 1, 7)
    End If
 Next i
 
 Cells(5, 13) = Hmin
 
End Sub

Qchan1962 · Accepted Answer

こんばんは、

Excelなら、＃７さんの関数を使用すれば、一発ですが、、ループでの考え方だとすると
この様な考え方で良いのではないでしょうか？

ご質問のコードは、一番小さいですね。
If Cells(i + 1, 7) < Hmin Then　を　
If Cells(i + 1, 7) > Hmin Then　すると直感的に最大が抽出できるのは分かると思います。

では、一度最大の値を抽出してから、もう一度、先の最大の値を除外した最大を抽出すれば、
2番目に大きいとなるのではないでしょうか？

通常Excelの場合、この様なプログラミングはしないかと思いますが、、
ご質問のやり方しか知らなく、それを工夫して実現する場合の参考です。
従って、出来るだけご質問のコードを生かし下記の様になります。

Sub task1()
Dim Hmin As Double, tmp As Double　’2番目を抽出する為の変数
Dim i As Long
　 Hmin = 0　'最大なので0で良いかと
　 For i = 1 To 912
　　 If Cells(i + 1, 7) > Hmin Then
　　　　Hmin = Cells(i + 1, 7)
　　 End If
　 Next i
'この時　Hmin　には最大値が代入されている
'Cells(5, 13) = Hmin

　 tmp = 0
　 For i = 1 To 912
'もう一度上記同様に最大値を抽出　ただし = Hminで最大値の場合除外する
　　 If Cells(i + 1, 7) < tmp Or Cells(i + 1, 7) = Hmin Then　'上と少し書き方が違うのは、検証して調べてくださいね。
　　 Else
　　　　tmp = Cells(i + 1, 7)
　　 End If
　 Next
　 Cells(5, 13) = tmp
End Sub

考え方を示したコードですが、同じようなやり方でも色々あります。
Excel場合、さらにやり方は沢山あります。

ShowMeHow · Answer

すみません、、、2番目の値が発生した後に、一番目の値が発生すると、うまくいかないですね。
二階ループ回したほうがわかりやすいのかもしれませんが、、、
結局、最初の部分（’****）も入れないダメですかね？

if Cells(i + 1, 7) > Hmax Then
if hmax2<hmax then '****
hmax2=hmax '****
end if '****
Hmax=Cells(i + 1, 7)
else if Cells(i + 1, 7) > Hmax2 Then
Hmax2=Cells(i + 1, 7)
end if

なんか、プログラムとして美しくないですね。
判断件数考えなくてよいなら、ソートしてしまうのがわかりやすくてよいのかもしれません。

めぐみん_ · Answer

もしこれが課題としての問題なら、何を習って出されたのかが不明ですと厳しいですよね。

fujillin · Answer

こんにちは

例示のコード中に「Cells」の表記がありますが、データはエクセルにあるってことでしょうか？

であるなら、ソートして2番目を読めば良いのでは？
元のデータ順を変えたくなければ、どこかにコピペしてからソートしても良いでしょう。

あるいは、ワークシート関数のLARGEを利用して2番目を求める方が簡単かもしれません。
（こちらなら一行で済みそうですし）
https://docs.microsoft.com/ja-jp/office/vba/api/excel.worksheetfunction.large

naktak · Answer

同じ値が複数行存在する可能性があるなら、降順に並び替え済みなので、比較も簡単に済みます。
    Call Range(Cells(1, 7), Cells(912, 7)).Copy(Cells(1, 10))
    Call Range(Cells(1, 10), Cells(912, 10)).Sort(Cells(1, 10), xlDescending)
    Dim valueOfTop1 As Long
    valueOfTop1 = Cells(1, 10).value
    Dim i As Long
    i = 2
    Do While True
        If valueOfTop1 <> Cells(i, 10).value Then
            Exit Do
        End If
        i = i + 1
    Loop
    MsgBox Cells(i, 10).value

naktak · Answer

列全体を降順に並び替えて2行目を取ればいいのでは。
元の値が並び替えられるのが嫌なら、別シートとか別列に丸ごとコピーしてから並び替え。

Call Range(Cells(1, 7), Cells(912, 7)).Copy(Cells(1, 10))
    Call Range(Cells(1, 10), Cells(912, 10)).Sort(Cells(1, 10), xlDescending)
    MsgBox Cells(2, 10).Value

ShowMeHow · Answer

二番めは二番めで判定させないとだめですね。

if Cells(i + 1, 7) > Hmax Then
Hmax=Cells(i + 1, 7)
else if Cells(i + 1, 7) > Hmax2 Then
Hmax2=Cells(i + 1, 7)
end if
みたいなことですね

大変失礼しました。

neKo_deux · Answer

プログラムでなくても、紙に900個数字が書かれていて、

> 2番目に大き身長を

探そうとしたら、1番目と2番目の数字を覚えといて、数字を上からながめて行き、
・1,2番より大きいか等しい数字が出たら、覚えてる1番目は新しい数字、2番目は1番だった数字に
・2番より大きいけど1番よりは小さい数字が出たら、2番目を新しい数字に
に更新して一番下までチェックとか。

--
数を減らして、
3 4 6 1 2 5 7 3 5
って数字を左からなめるとして、

最初、
1番大きい数字=4
2番目に大きい数字=3

6って数字を持ってきて、
1番目に大きい数字以上なので、
1番大きい数字=6
2番目に大きい数字=4

1って数字を持ってきて、
1番大きい数字=6
2番目に大きい数字=4

2って数字を持ってきて、
～

みたいな感じで、最後どうなるか確認したり、数字を変更してどうなるか確認してみるとか。

> プログラミングです！

ササッと出来りゃいいですが、出来ない場合はベタな方法でも、手を動かすのが上達のヒケツです。

ShowMeHow · Answer

最高が同じ高さなら、ダメか。
if Cells(i + 1, 7) ≧ Hmax
にしたほうがいいかも。

ShowMeHow · Answer

Hmax=cells(6,11)
Hmax2=0
for i = 1 to 912
if Cells(i + 1, 7) > Hmax Then
Hmax2=Hmax
Hmax=Cells(i + 1, 7)
end if
next i

全員同じ高さでなければ、これで行けるんじゃないかな

vbaの繰り返しで求める最大値について

こんばんは、

すみません、、、2番目の値が発生した後に、一番目の値が発生すると、うまくいかないですね。

もしこれが課題としての問題なら、何を習って出されたのかが不明ですと厳しいですよね。

こんにちは

同じ値が複数行存在する可能性があるなら、降順に並び替え済みなので、比較も簡単に済みます。

列全体を降順に並び替えて2行目を取ればいいのでは。

二番めは二番めで判定させないとだめですね。

プログラムでなくても、紙に900個数字が書かれていて、

最高が同じ高さなら、ダメか。

Hmax=cells(6,11)

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング