Excel関数とVBAの組み合わせで。

質問

名前　　｜　　総合計　　｜　　ランキング
あああ　｜　　10　　　　｜　　　3
いいい　｜　　12　　　　｜　　　2
ううう　　｜　　8　　　　　｜　　4
えええ　｜　　　20　　　　｜　　1
おおお　｜　　4　　　　　｜　　　5

というような感じでシートに入力されています。
（ランキングの部分はRANK関数を使用）

これを元にグラフを作成するために、1位から3位までを変動的に抽出するようなコードを下記のようにしました。

--------------------------------------------------
Sub IP_Graph()

Dim i As Integer
Dim Ranking As String
Dim Provider As String
Dim AccessCount As String
Dim Last As Integer '最終行取得

Last = Cells(2).CurrentRegion.Rows.Count

For i = 3 To Last

Ranking = Cells(i, 10)
Provider = Cells(i, 2)
AccessCount = Cells(i, 9)

Select Case Ranking
Case 1
Range("p_01") = Cells(i, 1)
Range("access_01") = Cells(i, 2)
Case 2
Range("p_02") = Cells(i, 1)
Range("access_02") = Cells(i, 2)
Case 3
Range("p_03") = Cells(i, 1)
Range("access_03") = Cells(i, 2)
End Select

Next

End Sub
--------------------------------------------------

上のように、1位から5位まで、ときちおんとランク分けされていればいいのですが、
実際は同じ数でランキングが同位だったりすることがおこります。
（例えば1位・2位・2位・4位・5位のように。）
このような場合抜き出して作成した表の3位の部分が空欄になってしまいます。
上位3つを抜き出すためにはどうしたらいいのでしょうか？

表示上の並べ替えは行いたくないです。

Ex:2000

回答No.1

maruru01 · ベストアンサー

こんにちは。maruru01です。

2位が2つあることより、3位が2つの場合はどうするのですか。もしくは、2位が3つ以上ある場合とか。

もし3位が2つある場合は任意の一方を抽出するという場合は、
・現状の並び順に番号を1から振った列を追加する。（名前順に並べてあるなら必要なし。）
・ランキング順に並べ替える。
・上から3つを抽出する。
・元の順に並べ替える。

もし3位が2つある場合は両方とも抽出する（抽出するデータ数が3つを越えてもOK）という場合は、
・ランキングが3以下のデータを抽出して並べる。（抽出した順にセルに入力していく。）
・抽出した表を並べ替える。

という風でしょうか。
並べ替えのコードはマクロを記録して確認して下さい。

お礼

確かにそういう可能性ありますね！！
考えてなかったです。
うまい具合に上位３つがぴったり切れる、なんてことはそうそうないですよね。

回答ありがとうございました。

回答No.4

imogasi

Ｒａｎｋ関数を使いませんが、考え方として、Large関数を使えば良いのではと思います。エクセルには色々関数があります。
ＶＢＡのコーディングも３行で済みます。
説明を簡単にするため、Ａ１：Ａ１０にデータがあるとして
11
33
13
19
6
15
22
4
11
33
のとき
Ａ１２：Ａ１４に
A12は=LARGE(A1:A10,1)　　　33
A13は=LARGE(A1:A10,2)　　　33
A14は=LARGE(A1:A10,3) 　　 22
と入れると結果は上記のようになります。
Worksheetfunctionとしてですが、使う事が出来て
下記で上位３個を取り出せます。
Sub test01()
For i = 1 To 3
a = Application.WorksheetFunction.Large(Range("a1:a10"), i)
MsgBox a
Next i
End Sub

お礼

ランクじゃなくてもOKなんですね。
目からうろこでした・・・。

#1の方のご指摘のように、上位３つとかってすると、同じ数なのに名前の関係で4番目になってしまったものなどがはずれてしまうことに気づいたので、
ランク関数を使い、1・2・3のものを違うシートへ抽出し、そこで並べ替えをして、
現在のシートへ貼付けをする、という形にしました。
1つのシートで行うのはまだ私には難しいみたいです。

でもLarge関数も違う時に使えそうなので覚えておこうと思います。
ありがとうございました。

回答No.3

nishi6

早く処理した順にセットしていく例です。ソートはしていません。
質問にある元のコードは余り変えていないつもりです。

Sub IP_Graph()
　　Dim i As Integer
　　Dim Ranking As String
　　Dim Provider As String
　　Dim AccessCount As String
　　Dim Last As Integer '最終行取得

　　Dim c1 As Integer, c2 As Integer, c3 As Integer '追加

　　Last = Cells(2).CurrentRegion.Rows.Count

　　For i = 3 To Last
　　　　Ranking = Cells(i, 10)
　　　　Provider = Cells(i, 2)
　　　　AccessCount = Cells(i, 9)

　　　　Select Case Ranking
　　　　　　Case 1
　　　　　　　　If c1 < 3 Then '1位はc1=0,1,2 の時、出力可
　　　　　　　　　　Range("p_01").Offset(c1, 0) = Cells(i, 1)
　　　　　　　　　　Range("access_01").Offset(c1, 0) = Cells(i, 2)
　　　　　　　　　　c1 = c1 + 1
　　　　　　　　End If
　　　　　　Case 2
　　　　　　　　If c2 < 2 Then '2位はc2=0,1 の時、出力可
　　　　　　　　　　Range("p_02").Offset(c2, 0) = Cells(i, 1)
　　　　　　　　　　Range("access_02").Offset(c2, 0) = Cells(i, 2)
　　　　　　　　　　c2 = c2 + 1
　　　　　　　　End If
　　　　　　Case 3
　　　　　　　　If c3 < 1 Then '3位はc2=0 の時、出力可
　　　　　　　　　　Range("p_03").Offset(c3, 0) = Cells(i, 1)
　　　　　　　　　　Range("access_03").Offset(c3, 0) = Cells(i, 2)
　　　　　　　　　　c3 = c3 + 1
　　　　　　　　End If
　　　　End Select
　　Next
End Sub

回答No.2

don_cha

エクセル表内でソートをしないということで・・・小手先ですが次のように変更してみました。

これで、一応１～３位までの順位が振られているものをすべて抽出し、表の９列目以降に上位順に出力させていますが・・・ご希望の形でしょうか？

※インデントを付けるためにわざと全角スペースを使用しています。

' ランキングデータ保存用構造体
Private Type RankData
　　Name As String　　　　　' 名前
　　Count As String　　　　 ' 総合計
　　Rank As String　　　　　' 順位
End Type

Sub IP_Graph()

　　Dim i, j, OPos, SPos As Integer ' カウンタ
　　Dim Best3() As RankData　　　　 ' 上位３位データ（抽出順）
　　Dim Best3Sort() As RankData　　 ' 上位３位データ（順位順）
　　Dim Last As Integer　　　　　　 ' 最終行取得

　　OPos = 0
　　Last = Cells(2).CurrentRegion.Rows.Count

　　' 上位３位までのデータを抽出
　　For i = 2 To Last
　　　　Ranking = Cells(i, 3)

　　　　Select Case Ranking
　　　　Case 1 To 3
　　　　　　OPos = OPos + 1
　　　　　　ReDim Preserve Best3(OPos)
　　　　　　Best3(OPos).Name = Cells(i, 1)
　　　　　　Best3(OPos).Count = Cells(i, 2)
　　　　　　Best3(OPos).Rank = Ranking
　　　　End Select
　　Next

　　' 抽出データ並び替え
　　SPos = 1
　　ReDim Best3Sort(OPos)
　　For j = 1 To 3
　　　　For i = 1 To OPos
　　　　　　Select Case Best3(i).Rank
　　　　　　Case j
　　　　　　　　Best3Sort(SPos).Name = Best3(i).Name
　　　　　　　　Best3Sort(SPos).Count = Best3(i).Count
　　　　　　　　Best3Sort(SPos).Rank = Best3(i).Rank
　　　　　　　　SPos = SPos + 1
　　　　　　End Select
　　　　Next
　　Next

　　' データを表へ出力
　　For i = 1 To OPos
　　　　Cells(i, 9) = Best3Sort(i).Name
　　　　Cells(i, 10) = Best3Sort(i).Count
　　　　Cells(i, 11) = Best3Sort(i).Rank
　　Next

End Sub

お礼

回答ありがとうございます。

やはり並べ替えはどこかで必要になってきますよね。
ただそれをどこでやるか、が問題なんですね。

ありがとうございました。