ExcelのVBAについて

前回も同じような質問をしたのですが、
同一グループ内において、点数の高い順から3つを転記したいのです。

質問して恐縮ですが、関数ではありません。
VBAで実行したいのです。


私の認識では、同一グループは、連想配列しかないと思っていましたが、別の方法があるのでしょうか？

実現したい方法か下記のURLです。

https://gyazo.com/382fa71fe40ccd9de063d12f88f6cf46

連想配列でかんがえていたのですが、煮詰まってしまいました。

お手数ですが、ご教示をお願いします。

よろしくお願いします。

No.5 ベストアンサー 回答者： tatsumaru77 回答日時： 2020/10/09 22:27

以下のマクロを標準モジュールに登録してください。

----------------------------------------------
Option Explicit

Sub ベスト3()
Dim maxrow As Long '最大行番号
Dim wrow As Long '行番号
Dim st_row As Long '開始行番号
Dim en_row As Long '終了行番号
Dim ws As Worksheet '作業シート
Dim prev_cls As String '前回のクラス
Dim crnt_cls As String '今回のクラス
Dim Points() As Variant '点数のテーブル
Dim ctr As Long 'データ件数
Set ws = ActiveSheet 'アクティブシートを処理する
maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'A列 最終行を求める
prev_cls = ""
st_row = 2
For wrow = 2 To maxrow '２～最終行まで繰り返す
crnt_cls = ws.Cells(wrow, 1).Value 'クラス取得
If crnt_cls <> prev_cls Then '前回のクラスと異なるなら
If prev_cls <> "" Then '前回のクラスが空白以外なら点数の出力を行う
Call flush_data(ws, st_row, en_row, Points)
End If
prev_cls = crnt_cls '今回のクラスを前回へシフト
st_row = wrow '現在行を開始行へ設定
ctr = 0 'データ件数をクリア
End If
ReDim Preserve Points(ctr) 'データ件数分の配列の要素を確保
Points(ctr) = ws.Cells(wrow, "B").Value '点数を保存
ctr = ctr + 1 'データ件数加算
en_row = wrow '現在行を終了行へ設定
Next
Call flush_data(ws, st_row, en_row, Points) '点数の出力
MsgBox ("完了")
End Sub
'点数の出力
Private Sub flush_data(ByVal ws As Worksheet, ByVal st_row As Long, ByVal en_row As Long, ByVal Points As Variant)
Dim p1 As Variant '1番目に高い点数
Dim p2 As Variant '2番目に高い点数
Dim p3 As Variant '3番目に高い点数
Dim wrow As Long '行番号
p1 = GetMax(Points) '最大値取得
p2 = GetMax(Points) '最大値取得
p3 = GetMax(Points) '最大値取得
For wrow = st_row To en_row '開始行～終了行まで繰り返す
ws.Cells(wrow, "C").Value = p1
ws.Cells(wrow, "D").Value = p2
ws.Cells(wrow, "E").Value = p3
Next
End Sub

'Pointsから最大を検索し、その値を返す。最大値は次回の検索のためにEmptyに設定しておく。
Private Function GetMax(ByRef Points As Variant) As Variant
Dim i As Long
Dim max As Variant
max = Empty
'最大値を検索する
For i = 0 To UBound(Points)
If IsEmpty(Points(i)) = False Then
If IsEmpty(max) = True Or Points(i) > max Then
max = Points(i)
End If
End If
Next
'最大値をEmptyに置き換える
For i = 0 To UBound(Points)
If Points(i) = max Then
Points(i) = Empty
End If
Next
GetMax = max
End Function

この回答へのお礼

何度も回答していただきありがとうございました。
もっと勉強したいと思います。

お礼日時：2020/10/10 06:56

No.6 回答者： Qchan1962 回答日時： 2020/10/10 00:48

こんばんは、

既に回答もアドバイスも出ているように思いますが、
＞私の認識では、同一グループは、連想配列しかないと思っていましたが、
＞別の方法があるのでしょうか？
と言う事で、別案を考えてみました。
少し疑問に思った点ですが、A列が昇順になっていますが、なぜB列は降順にしないのでしょうか？
B列を大きい順にしてしまえば、同じグループの上3行を抜き出せば良い事になると思います。
条件を設定するにも連想配列の方が分かりやすいと思いますが、敢えてべたにループさせてみました。
遊びのような、コードなのでスルーして頂いて良いと思いますが、一応、掲示させていただきます。
添付図を参考にしています。

Option Explicit
Sub sample()
Dim i As Long, j As Long, n As Integer
Dim tmp, ary(2)
　　Call Range(Cells(2, "A"), Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B")).Sort _
　　　　 (Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2"), Order2:=xlDescending)
　　tmp = Cells(2, "A").Value
　　i = 1
　　Do
　　　　i = i + 1
　　　　If tmp = Cells(i, "A").Value Then
　　　　　　If j < 3 Then
　　　　　　　　ary(j) = Cells(i, "B").Value
　　　　　　　　j = j + 1
　　　　　　End If
　　　　　　n = n + 1
　　　　Else
　　　　　　Cells(i, "C").Offset(-n).Resize(n, 3) = ary
　　　　　　Erase ary
　　　　　　tmp = Cells(i, "A").Value
　　　　　　i = i - 1
　　　　　　n = 0
　　　　　　j = 0
　　　　End If
　　Loop While Cells(i, "A").Value <> ""
End Sub

この回答へのお礼

回答ありがとうございました。
コード参考にさせていただきます。
申し訳ないですが、ベストアンサーは、tatsumaru77さんにさせていただきます。
本当にありがとうございました。

お礼日時：2020/10/10 06:56

No.4 回答者： fujillin 回答日時： 2020/10/09 20:05

こんばんは

＞連想配列しかないと思っていましたが、別の方法があるのでしょうか？
VBAからでもほとんどのシート関数が利用できますので、ほぼ計算せずとも結果を得ることができます。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

関数を利用する別の方法として、結果を表示したいセルに（あるいは、一時的に空きセルを利用して）関数式を設定して、値を読み込むというものも考えられます。
まぁ、これらの方法だと、VBAで計算するというよりも関数式を考えるところで、ほとんどの計算をしていることになりますけれど。

この回答へのお礼

回答ありがとうございます。
参考にします。

お礼日時：2020/10/09 20:22

No.3 回答者： tatsumaru77 回答日時： 2020/10/09 19:10

画像では同じグループは連続していますが、グループが連続しないこともありますか？

例えば
２行　A1
３行　A1
４行　B1
５行　A1
６行　B1
のように並ぶケースです。

この回答へのお礼

回答ありがとうございます。
必ず連続します。

お礼日時：2020/10/09 20:15

No.2 回答者： めぐみん_ 回答日時： 2020/10/09 19:07

どのような結果をお望みなのかはわかりませんが、クラス毎で点数の上位３つ（大中小はなんだろう？）と言うのなら、降順で並び替えても出来ますしね。

連想配列（Dictionaryオブジェクトなど）でも出来るでしょう。

http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …

このようなものもあります。

この回答へのお礼

いつも回答ありがとうございます。
参考にします。

お礼日時：2020/10/09 20:21

No.1 回答者： tatsumaru77 回答日時： 2020/10/09 19:05

同じ点数が2つ以上の場合は、どうしたいのでしょうか。

例として、画像の、A1グループの５０の値（B3セル）がもし８０なら、
８０、８０、７０ですか、
それとも、
８０、７０、６０でしょうか？

この回答へのお礼

回答ありがとうございます。
８０、７０、６０になります。

お礼日時：2020/10/09 20:20