Excel上のVBAで資料作成をおこなっているのですが、一部、どうしたら良いのかわかりません。
アドバイスをお願いいたします。
■やりたいこと
・Excelの一覧表で、行ごとに1番大きい値と2番目に大きい値を取得する。
・取得する際、項目名(1行目にある値)も併せて取得する。
・取得数の上限は2件のため、1番目、2番目がそれぞれ複数ある場合、
あらかじめ用意してある、優先順位の表にしたがって上位2件を取得する。
■例
・図のような成績表があった場合、取得結果は以下を想定しています。
Aさん→国語:100、英語:90
Bさん→数学:100、社会:90
Cさん→国語:80、数学:60
※
・Aさん:
・最大値→国語:100
・2番目→英語:90
最大値、2番目ともに、そのまま取得でOK。
・Bさん:
・最大値→数学:100
そのまま取得でOK
・2番目→理科と社会の90
優先順位で社会が上位にあるため、社会を取得。
・Cさん:
・最大値→国語と英語の80
優先順位で国語が上位にあるため、国語を取得。
・2番目→数学と理科の60
優先順位で数学が上位にあるため、数学を取得。
よろしくお願いします。
A 回答 (6件)
- 最新から表示
- 回答順に表示
No.6
- 回答日時:
No.4です。
前回のコードではエラーになりマクロが止まってしまいます。
最後から5行目の
>wS.Range(Columns(3), Columns(lastCol)).Delete
を
>Range(wS.Columns(3), wS.Columns(lastCol)).Delete
に変更してください。
どうも失礼しました。m(_ _)m
No.5
- 回答日時:
こんにちは。
この表を見ていて気がついたことですが、#1さんがご指摘の、
「優先順位を考慮した成績表を別に作った方が良さそうに思えます。」
同感です。あえて、それを、プログラム上で行うとすれば、配列変数(myIndex )の中でしかありません。むろん、Excelなら、ダミーの表を作ってもよいかもしれません。一応、既存のユーザーの表自体を動かしてはいけない、という暗黙のルールには従いましたが…。VBAでは、ややこしくなるようです。
#1さんの回答にように、これは、関数でもできるような気がしますね。私自身は、関数が不得意なので、選択肢はありませんでしたが。
'//
Sub OrderAsRequest()
Dim Rng As Range
Dim Rng2 As Range
Dim myIndex As Variant
Dim i As Long, j As Long, k As Long
Dim n As Variant
Dim mySubject As Variant
Dim max1 As Long, max2 As Long
Dim subj1 As String, subj2 As String
'出力先用
Dim ws As Worksheet
Dim m As Long
Set ws = Worksheets(2) '#4さんと同等にしました。
m = 1
Set Rng = Range("A1:F4") 'テスト成績表
Set Rng2 = Range("A7:B11") '優先順位
With Rng
Set Rng = .Offset(0, 1).Resize(.Rows.Count, .Columns.Count - 1)
End With
ReDim mySubject(Rng2.Rows.Count - 1)
ReDim myIndex(Rng.Rows.Count - 2, Rng.Columns.Count)
For i = 1 To Rng2.Rows.Count
mySubject(i - 1) = Rng2.Cells(i, 2).Value
Next i
'Rng2のフォーマットに従い優先順位に並べ替え
For i = 2 To Rng.Rows.Count
myIndex(i - 2, 0) = Rng.Cells(i, 1).Offset(, -1).Value '人名 F
For j = LBound(mySubject) To UBound(mySubject)
n = Application.Match(mySubject(j), Rng.Rows(1), 0)
myIndex(i - 2, j + 1) = Rng.Cells(i, n).Value
Next j
Next i
k = 2
'検索
For i = LBound(myIndex) To UBound(myIndex)
For j = LBound(myIndex, 2) + 1 To UBound(myIndex, 2)
If myIndex(i, j) > max1 Then
max1 = myIndex(i, j)
subj1 = mySubject(j - 1)
End If
Next j
'注意:出力先1
With ws
.Cells(m, 1).Value = myIndex(i, 0)
.Cells(m, 2).Value = subj1
.Cells(m, 3).Value = max1
End With
'二番目を調べる
For j = LBound(myIndex, 2) + 1 To UBound(myIndex, 2)
If mySubject(j - 1) <> subj1 Then
If myIndex(i, j) > max2 Then
max2 = myIndex(i, j)
subj2 = mySubject(j - 1)
End If
End If
Next j
'注意:出力先2
With ws
.Cells(m, 4).Value = subj2
.Cells(m, 5).Value = max2
End With
k = k + 1
m = m + 1
max1 = 0: max2 = 0: subj1 = "": subj2 = ""
Next i
End Sub
'//
No.4
- 回答日時:
こんばんは!
一例です。
Sheet1のデータをSheet2のA・B列に表示するようにしてみました。
元データの1行目は項目で、データはA2セル以降にあるとします。
標準モジュールです。
Sub Sample1()
Dim i As Long, k As Long, lastCol As Long
Dim c As Range, r As Range, myRng As Range, wS As Worksheet, myBst, mySnd, myAry
myAry = Array("国語", "英語", "社会", "数学", "理科") '←優先順位★
Set wS = Worksheets("Sheet2")
wS.Cells.Clear
'▼ Sheet2、C1セル以降に科目を優先順位順に表示(作業用として並び替え)
For k = 0 To UBound(myAry)
wS.Cells(1, k + 3) = myAry(k)
Next k
lastCol = wS.Cells(1, Columns.Count).End(xlToLeft).Column
With Worksheets("Sheet1")
'▼ Sheet2のC列以降の科目順に検索し、同じ数値がない場合のみその科目の数値を表示
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
For k = 3 To lastCol
Set c = .Rows(1).Find(what:=wS.Cells(1, k), LookIn:=xlValues, lookat:=xlWhole)
If WorksheetFunction.CountIf(wS.Rows(i), .Cells(i, c.Column)) = 0 Then
wS.Cells(i, k) = .Cells(i, c.Column)
End If
Next k
'▼ Sheet2のC列~最終列を「myRng」に格納
Set myRng = Range(wS.Cells(i, "B"), wS.Cells(i, lastCol))
'▼ myRng範囲の最大値と2番目の値を取得
myBst = WorksheetFunction.Max(myRng)
Set c = wS.Rows(i).Find(what:=myBst, LookIn:=xlValues, lookat:=xlWhole)
'▼ 万一すべての科目が同点の場合の処理
If WorksheetFunction.Count(myRng) > 1 Then
mySnd = WorksheetFunction.Large(myRng, 2)
End If
Set r = wS.Rows(i).Find(what:=mySnd, LookIn:=xlValues, lookat:=xlWhole)
'▼ Sheet2のA列にSheet1のA列データを、B列に最大値の科目:点数、2番目の科目:点数 を表示
wS.Cells(i, "A") = .Cells(i, "A")
If Not r Is Nothing Then
wS.Cells(i, "B") = wS.Cells(1, c.Column) & ":" & myBst & "、" & wS.Cells(1, r.Column) & ":" & mySnd
Else
wS.Cells(i, "B") = wS.Cells(1, c.Column) & ":" & myBst
End If
Next i
wS.Range(Columns(3), Columns(lastCol)).Delete
wS.Columns.AutoFit
wS.Range("A2").CurrentRegion.Borders.LineStyle = xlContinuous
End With
End Sub
※ 現実問題としてあるかどうかは判りませんが、
すべての科目が同点の場合は1科目(最優先)しか表示されません。m(_ _)m
No.1
- 回答日時:
「何番目に大きい」を取り出す時はLARGE関数を使用します。
また、今回の内容ですと、優先順位を考慮した成績表を別に作った方が良さそうに思えます。
添付の図ではA13:F16を優先順位を考慮した成績表として使っています。
B14に↓を入れてB14:F16にコピーしています。
=B2-MATCH(B$13,$B$7:$B$11,0)/100
次にH2とI2には以下の式を入れます。
H2セル:=INDEX($B$1:$F$1,0,MATCH(LARGE($B14:$F14,1),$B14:$F14,0))
I2セル:=INDEX($B$1:$F$1,0,MATCH(LARGE($B14:$F14,2),$B14:$F14,0))
H2:I2を下2つにもコピーします。
こんな感じで如何でしょう。
この回答への補足
webonerさんからご指摘いただきました。ありがとうございます。
Cさんについては、ご指摘の通り以下になります。
・Cさん:
・最大値→国語と英語の80
優先順位で国語が上位にあるため、国語を取得。
・2番目→英語を取得。
>・Cさん: >・2番目→数学と理科の60?? 国語と英語の80であれば、数学と理科の60は2番目じゃなくて3番目なんじゃ?
>・Cさん:
>・2番目→数学と理科の60??
国語と英語の80であれば、数学と理科の60は2番目じゃなくて3番目なんじゃ?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 日本語 ご添削をお願いいたします。 *I大学人文社会科学系事務部 教務課(文学部・人文科学府担当)ご担当先 4 2022/04/18 12:39
- C言語・C++・C# C言語 プログラミング 4 2022/05/22 11:53
- 高校 高校のテストの高得点 3 2023/05/24 21:04
- 大学受験 理学療法の大学に行こうと考えていて、第1志望の大学が模試でE判定で、国語、英語、数学が必須の入試科目 2 2023/08/01 22:14
- 高校受験 こんにちは。今年新中3の女子です。私は現在ノー勉&授業ほぼ聞いてなくて5教科が111点でした。 国語 3 2022/03/25 13:36
- 大学受験 数学が苦手で社会が得意な場合は一橋よりも東大の方が受かりやすい、ということはあり得ますか? 3 2022/04/16 16:46
- 高校受験 公立高校の英語科に行きたいのですが 3 2022/10/07 01:26
- 大学受験 推薦入試について教えていただきたいことがあります。 私は、この春高校三年生になります。進路について考 1 2022/04/05 02:04
- 大学受験 国立受験 11月からの大逆転劇を起こすには 7 2022/11/14 19:24
- 大学受験 娘の大学受験勉強 6 2022/06/30 19:58
このQ&Aを見た人はこんなQ&Aも見ています
-
賃貸で可能な古民家風レトロな部屋作りのコツ!改めて知る畳の高い機能性と魅力も紹介
畳の部屋を雰囲気のよい部屋に仕上げたい!賃貸住宅でもできる古民家風のレトロな部屋作りのコツを伺った。
-
2つ以上の変数を比較して最大数を求めたい
Word(ワード)
-
【Excel VBA】指定した行の最大値を持つセル番地を取得したい
Excel(エクセル)
-
EXCELマクロ 保護されているシートのダイアログを表示させない方法
Visual Basic(VBA)
-
-
4
配列の中の最大値とそのインデックス番号を取得する方法
Visual Basic(VBA)
-
5
ExcelのLarge関数で抽出したセルの行/列名
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelのマクロについて教えてく...
-
Excel 範囲指定スクショについ...
-
プログラミング
-
ユーザーフォームに別シートか...
-
VBAコードについて教えてくださ...
-
Excelのマクロについて教えてく...
-
エクセルVBAコードで教えて下さ...
-
vba アクティブシートの名前変...
-
Outlookの「受信日時」「件名」...
-
VBA 別ブックからコピペしたい...
-
【ExcelVBA】インデックスが有...
-
VBAに詳しい方教えてください。
-
ExcelのVBAコードについて教え...
-
Outlookの「受信日時」「送信者...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
VBA listBoxから
-
Excel VBA 定義されたプロージ...
-
エクセルVBAの配列について
-
配列のペースト出力結果の書式...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBAで大量のファイルをシート名...
-
VBA レジストリの値の読み方に...
-
Excelのマクロについて教えてく...
-
ユーザーフォームに別シートか...
-
VBAの計算で@が出てしまう件
-
エクセルVBAについて
-
Vba 実数および実数タイプの変...
-
【ExcelVBA】値を変更しながら...
-
VBA一覧取得 再投稿
-
VBA指定行削除
-
エクセルVBAについて
-
VBA ユーザーフォーム ボタンク...
-
VBA 何かしら文字が入っていたら
-
エクセルについて
-
2つのマクロでチェックボックス...
-
【マクロ】1つのマクロの中に...
-
ExcelのVBAコードについて教え...
-
VB.net(VB)で、フォームにExcel...
-
Vba SelStart、SelLen教えてく...
-
Excel-VBAのmsgBox()の不思議
おすすめ情報