Excelマクロでスコアによる順位付けをしたい方法

前へ 次へ
このQ&Aのポイント
  • Excelマクロを使用して、スコアによって順位付けを行いたいと考えていますが、具体的な方法を知りません。ゴルフの成績表があり、E列に順位を入力したいのですが、どのようにすればよいのでしょうか？初心者ですので、わかりやすく教えていただけると助かります。
  • 自分で作ったマクロを使用して順位付けを行いたいのですが、コンパイルエラーが発生し、正常に動作しません。マクロの修正方法など、教えていただけると助かります。
  • Excelマクロでスコアによる順位付けをする方法について教えてください。ゴルフの成績表があり、E列に順位を入力したいのですが、具体的な手順がわかりません。初心者向けのわかりやすい解説をお願いします。
回答を見る
  • ベストアンサー

Ｅｘｃｅｌマクロで、スコアによって順位付けをしたい。

Ｅｘｃｅｌマクロで、スコアによって順位付けをしたい。 極初心者ですみません　教えて下さい。 ゴルフの成績表が作ってあり、Ｅ列に順位付けをしたい。 １．カーソルをＥ５に移動し(最初の順位入力位置) ２．もしそのセルから４個右側のセル内の数字が３０以上であれば(Ｅ５)に１(i)を入力し、 ３．セル位置を１つ下に移動する。 ４．上記２．３．の処理を繰り返す。 ５．もし、４個右側が０(ゼロ:不参加)であれば　i に５０を加えた数字を入力する。 という作業をしたいのですが、どうしても解りません、教えて下さい。 以下は、自分が作ったマクロですが、コンパイルエラーで作動しません。 Sub 順位付け() ' 順位付け Macro ' 優勝２位３位の順位付けを行う For i = 1 To 34 If Cells(i, 4).Value > 30 Then Value = i Range(E5).Offset(i, 0).Select Else Value = i + 50 Range(E5).Offset(i, 0).Select End If Next i End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • nda23
  • ベストアンサー率54% (777/1415)
回答No.1

気になる点を挙げます。 >If Cells(i, 4).Value > 30 Then E列ならCells(i, 5)のはずです。 「30以上」は30も含むので">=30"とすべきです。 >Value = i Valueという変数はありません。 E5に設定するなら、Cells(5, 5).Value = 1 になります。 >Range(E5).Offset(i, 0).Select E5という変数は未定義です。 Range("E5")のように文字定数にします。 また、Selectしただけでは何も起きません。 >Else >５．もし、４個右側が０(ゼロ:不参加)であれば　 先のIfのElseは30以下になります。=0ではありません。 よって、ElseIf Cells(i, 5) = 0 Then とすべき。 最後に、E5セルに次々と上書きしていますが、これでは 最後に処理する34行目の結果しか反映されないのでは？

kyoutanuki
質問者

お礼

ありがとうございました。 当方ごく初心者で、ご指摘の意味がわからず、いろいろ本を読んで勉強しました。 以下のようにした結果、うまく思い通りに出来ました。 お礼が遅くなり申し訳ありませんでした。 Sub 順位付け() ' 順位付け Macro ' 優勝２位３位の順位付けを行う For i = 5 To 38 '５行目から３８行目まで３４名分 If Cells(i, 9).Value >= 30 Then 'その行の９列目の数字が３０以上であれば Cells(i, 5).Value = i - 4 '５列目に、１位から順位を付ける Else 'その行の９列目の数字が３０未満(不参加)であれば Cells(i, 5).Value = i + 40 '順位を４０足した順位とする End If Next i End Sub '

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. その他MS Office製品

関連するQ&A

  • エクセルのマクロで

    お世話になります 下記のマクロで実行した所 １００まで書式設定で保護、ロックしたいのですが b3：l3はロックするものの ４行目以降はロックしません どうしたらいいでしょうか もう１つ、このシートはいつもｃ３からはじめたいのですが If ActiveCell.Value >= "" Then の部分はどうしたらいいでしょうか よろしくおねがいいたします 初心者でバカな質問ですみません Sub マクロ１() Dim i As Integer For i = 1 To 100 If ActiveCell.Value >= "" Then Range("B3:l3").Select Selection.Locked = True Selection.FormulaHidden = False End If ActiveCell.Offset(1, 0).Select Next End Sub

  • Excelマクロについて

    先日、OKWEBで教えてもらったマクロに手を加えて作ろうとしたのですが、エラーがでて動かなくなりました。 わかる方がいましたら教えてください。 よろしくおねがいします。 Sub 見積書() Application.ScreenUpdating = False '見積書(完成)シートを選択 Sheets("見積書(完成)").Select '行の高さを「15」にする。 Rows("6:67").Select Range("F6").Activate Selection.RowHeight = 15 'S列のS6:S56をコピーしてE6:E7に貼り付ける。 Range("S6:S56").Select Selection.Copy Range("E6:E7").Select ActiveSheet.Paste '5列目(工数)が「0」のとき該当する行の高さを「0」にする。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" And Cells(i, 7).Value = "0" Then Rows(i).RowHeight = 0 End If Next '「E8:E55」の範囲を四捨五入する。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next 'C列の中に含まれる「小計」を検索しそこから6列目が「0」だったら行の高さを「0」にする。 Dim Rng As Range Const Retu = "C" For Each Rng In Range(Retu & "1", Range(Retu & "100").End(xlUp)) If Trim(Rng.Value) = "小　　　計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub

  • 2つのマクロをうまく動かすにはどうしたら？

    以下の2つのマクロを同時に動かそうとしています マクロ2はマクロ1で出した数字から始めの値段と終わりの値段と高安4つをエクセル関数で抽出して 出した4つの数字を24個蓄積することをめざしてます。 それぞれは1つで起動させるとうまく動くのですが 同時に動かすとマクロ1は4つずつ記録を始めたりと思い通りに動きません。 これを解決するにはどうしたらいいでしょうか？ Sub Macro1() Range("E65536").End(xlUp).Offset(1).Resize(1, 4).Value = Range("A2:D2").Value If Range("E65536").End(xlUp).Row > 30 Then '31行に到達してから１行目を削除する Range("E1:H30").Delete shift:=xlShiftUp End If Application.OnTime Application.Floor(Now, TimeSerial(0, 1, 0)) + TimeSerial(0, 1, 0), "Macro1" End Sub Sub Macro2() Range("I65536").End(xlUp).Offset(1).Resize(1, 4).Value = Range("A5:D5").Value If Range("I65536").End(xlUp).Row > 24 Then '25行に到達してから１行目を削除する Range("I1:L1").Delete shift:=xlShiftUp End If Application.OnTime Application.Floor(Now, TimeSerial(0, 30, 0)) + TimeSerial(0, 30, 0), "Macro2" End Sub 追加としてマクロ1は30分もしくは00分（9時00分、９時３０分、１０時１１時も同様）に記録を始めて ９時1分や31分には一旦削除最初から記録を蓄積するということを目指してます。 つまり１０時10分からマクロを動かすと１０時31分になると一旦削除して最初から始めるとうものです。 こちらも可能ならお願いします！

  • エクセル 2010 マクロ 検索

    http://okwave.jp/qa/q8562170.html 上記質問に追加です。 ※1 'D,E,F,G,H,I,K を検索してD,E,F,G,H,I に検索対象があった時 E,F,G,H,Iのいずれかだったら左横列の上に向かって (EならD　、FならE ・・・という具合に) 何か入力されているセルのM列の191000####をmsgboxで表示させたいです。 (画 F11セル(A-1)が検索ヒットした場合E9セル(R-01)を辿り、 その行のM列のセル(191000####)をmsgboxで表示 ※2 但し、検索結果がD列のデータだった時、その行のM列が191000####だった場合 M列の191000####をmsgboxで表示させたいです。 (画 D25セル(Y-1)対象の時) ※3 また、検索結果がD列のデータだった時、その行のM列が191000####以外だった場合 (空白だったり191000####以外の場合) M列の一番上の191000####をmsgboxで 191000####&「これは例外です」と表示させたいです。 (画 D24セル (X-1)対象の時) 現在のコードは下記のとおりです。 Sheet1に Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address <> "$A$3" Then Exit Sub Call 検索 Range("A1:A2").Clear Range("A1").Activate End Sub 標準モジュールに Sub 検索() 　Dim Ws1 As Worksheet, Ws2 As Worksheet 　Dim strKey As Variant 　Dim s As String 　Dim c As Range, bln As Boolean 　Dim rng1 As Range 　Dim cnt As Long 　 　Set Ws1 = Sheet1 　Set Ws2 = Sheet2 　 　Ws1.Select 　 　With Ws2 　　strKey = Application.Transpose(.Range("A1").Resize(2).Value) 　　strKey = Join(strKey, "") 　End With 　 　If Trim(strKey) = "" Then MsgBox "検索キーが空です", vbCritical: Exit Sub 　 　 　With Ws1 　　Set rng1 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp)) 　　For Each c In rng1.Offset(, -10) 　　　 'D,E,F,G,H,I,Kを検索 　　　s = c.Offset(0, 3).Value & c.Offset(0, 4).Value & c.Offset(0, 5).Value & c.Offset(0, 6).Value & c.Offset(0, 7).Value & c.Offset(0, 8).Value & c.Offset(0, 10).Value & 　　　 　　　If StrComp(s, strKey, vbTextCompare) = 0 And c.Offset(0, 2).Value = "" Then 　　　　c.End(xlToRight).Activate c.Offset(0, 2).Value = Date 　　　　 　　　　c.Resize(1, 14).Interior.ColorIndex = 6 　　　　bln = True 　　　　Exit For 　　　End If 　　Next c 　　 　　If Not bln Then 　　　Ws2.Select 　　　MsgBox "リストに存在しません", vbExclamation, "NotFound" 　　Else '加える 　　　Call ReSearch(Ws1.Range("M2"), c.Row) 　　　'再設定 　　　Set rng1 = .Range("K6", .Cells(Rows.Count, "K").End(xlUp)) 　　　MsgBox "残り" & DoubleCountBlank(rng1.Offset(, -8), rng1) & "品目です。", vbInformation 　　End If 　End With 　Application.Goto Ws2.Range("A1"), True End Sub Sub ReSearch(Rng As Range, j As Long) '最初のセル, 終わりの行数 Dim i As Long Dim Ws As Worksheet With Rng.Parent For i = j To Rng.Row Step -1 If CStr(.Cells(i, Rng.Column).Value) Like "191000####" Then MsgBox "指図番号 " & vbCrLf & CStr(.Cells(i, Rng.Column).Value) & " の部品です" Exit For End If Next i End With End Sub Function DoubleCountBlank(rng1 As Range, rng2 As Range) '横並びのセルのブランクをカウントする (セル範囲1 , セル範囲2) 　Dim i As Long 　Dim cnt As Long 　For i = 1 To rng1.Rows.Count 　　If VarType(rng2.Cells(i, 1)) = vbDouble Then 　　　If rng1.Cells(i, 1).Value = "" And rng2.Cells(i, 1).Value <> 0 Then 　　　　cnt = cnt + 1 　　　End If 　　End If 　Next i 　DoubleCountBlank = cnt End Function 宜しくお願い致します。

  • マクロ　繰り返し　offset

    マクロについての質問です。 私自身まだ勉強中でまだ初心者です。 マクロを作ってみたのですが、自分の思い通りに動いてくれません。 どなたか詳しい方ご教授いただけませんか？ 下記にマクロのせておきます。 Sheets("Sペストリ").Select For i = 1 To 10 Range("D3").Select ActiveCell.Offset(0, 1).Select If ActiveCell.Value = "" Then Exit For Else Selection.Copy Sheets("印刷").Select Range("A1").Select ActiveCell.Offset(1, 0).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If Next i End Sub 私がやりたいことは、SペストリというシートのD3セルを選びそこから右にコピーしながらブランクが来るまでOFFSETし、印刷シートのA1セルから下にコピーしたセルの情報んペーストOFFSETしていく感じにしたいのですがうまくいきません。 よろしくお願いいたします。

  • エクセルマクロでの計算について（2007）

    エクセルマクロ初心者です。 試行錯誤しながら作成しています。 セルB1には直接計算式を入れており（=(480+(A1)*10)/480*I1） その結果次第（70以下）でセルC1に計算結果（=(75-B1)*.48)をいれて 70より大きければセルC1に"-"を入れたいのですが上手く計算してくれません。 この処理を約６５個のセルにしようと思っています。（セルの列はバラバラです） どうすればよいかご教示ください。 ちなみに現在作成している文は Private Sub 計算_Click() Worksheets("sheet2").Select If Range("B1").Value <= 70 Then Range("C1").Formula = "=(75 - (B1)) * 0.48" Else: Range("C1").Value = "-" End If End Sub よろしくお願いいたします。

  • エクセルのマクロについて教えてください

    お世話になっております。 エクセルのマクロについて教えていただきたいのですが、 サンプルのファイルをこちらにアップしたのでよろしければご覧になってください。 http://kie.nu/yPV 質問したいことは、列Iに、各行の黄色いセルの数を表示させるマクロを作りたいのですが 途中まで何とかわかったのですがどうもうまくいきません。。 行11から各行にひとつずつ、黄色いセルが含まれていますが、その黄色いセルの中の数字を列Iに表示させたいです。行にデータがある限り、下までずっとです。 以下、途中までわかったマクロです。 Sub 黄セル値Copy() Const TgLeftUp = "A3" '<--対象範囲左上セル指定 Dim Rng As Range Dim Target As Range Set Target = Range(TgLeftUp, Cells(Rows.Count, _ Range(TgLeftUp).Column)) For Each Rng In Target.Resize(, 2) If Rng.Interior.ColorIndex = 6 Then If Rng.Column = Target.Column Then Rng.Offset(, 3).Value = Rng.Value Else Rng.Offset(, 2).Value = Rng.Value End If End If Next MsgBox "値 貼り付け完了。", vbInformation Set Target = Nothing End Sub でもこれを貼り付けてもうまくいきません。 正しいマクロを教えていただけないでしょうか？？ 宜しくお願いいたします。 ※いつも、私の質問に対してまるで回答になってないような、ふざけた言葉を書き込んでは消してる方が一名だけいらっしゃいます。確か、鳥の写真をマイページに載せてる方です。 都度違反報告はしていますが、質問の趣旨に反する回答をされてる方一名、絶対にやめてください。

  • このマクロ、どこがおかしいですか？

    i5とj5のセルの文字が同じ場合はセル同士を結合して一つ下の行へ行き、i5とj5のセルに何も書かれていないときはそのまま一つ下の列へ行き、行った先のセルでも同じように処理(i6とj6のセルの文字が同じ場合はセル同士を結合して一つ下の行へ行き、i6とj6のセルに何も書かれていないときはそのまま一つ下の列へ行き)を繰り返し、と言うことをi33とj33のセルまで続けたいと思っています。 Sub よろしくお願いします() Dim i As Integer For i = 5 To 33 Cells(i, 9).Select If Cells(i, 9).Value = Cells(i, 10).Value Then Range(Cells(i, 9), Cells(i, 10)).Merge Selection.Offset(i + 1).Select ElseIf Cells(i, 9).Value = "" Then Selection.Offset(i + 1).Select Next i End If End Sub と書いたのですが、『Nextに対応するForがありません』と言われてしまいます。どうすれば思い通りにできるでしょうか？ 極めて初心者で、伝わりにくい点があるかもしれません。よろしくお願いします。

  • EXCELでENTERキーでセルの移動マクロ

    こんにちは。 EXCELでENTERキーでセルの移動マクロを使いたいのですが、下記のマクロで改良を教えてもらいたいと思います。 まず、最初は必ず、セルB5にフォーカスしたいということ。そうして、できればOFFSETを使わないで、rangeかcellを使いたいのですが、お願いします。 Sub セル移動() Range("B5").Select Select Case ActiveCell.Column Case 1 ActiveCell.Offset(1, 1).Activate Case 2 ActiveCell.Offset(2, 2).Activate Case 3 ActiveCell.Offset(1, 1).Activate Case 4 ActiveCell.Offset(1, 1).Activate End Select End Sub

  • エクセル　マクロを利用して繰り返して入力する方法

    マクロでA1B1C1D1E1F1セルに入力しF1入力後A2B2C2D2E2F2と 下方向へ繰り返し800行くらいまで入力し、それとB列はスキップしたいのですが下記の方法で別々のシートでは うまくいくのですが同じシ-ト内ではエラ－になってしまいます 次の行への移動 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 7 Then Cells(Target.Row + 1, 1).Select End If End Sub B列のスキップ Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("G1") <> "" Then If Target.Column = 2 Then Target.Offset(0, 1).Select End If End If End Sub どなたかご存じの方教えて下さい

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する