Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

39949 / 76732

←次へ　｜　前へ→


	【41887】Re:順位のつけ方

Kein - 06/8/24(木) 23:06 -


	引用なし

	パスワード

ちょっとその表の作り方ではうまくいかないので、H列以降の値は全てクリア
しておいて下さい。H:J列の表組みも含めて、一気にマクロでやってみます。
コードは以下のようになります。L列は作業列とします。

Sub MyLank()
　 Dim LR As Long
　
　 Application.ScreenUpdating = False
　 Range("H1:L1").Value = _
　 Array("勝ち", "負け", "引き分け", "順位", "行")
　 LR = Range("A65536").End(xlUp).Row - 1
　 With Range("H2:J2")
　　　.Formula = Array("=COUNTIF($B2:$G2,""○"")", _
　　　"=COUNTIF($B2:$G2,""×"")", "=COUNTIF($B2:$G2,""△"")")
　　　.AutoFill .Resize(LR), xlFillCopy
　 End With
　 With Range("H2").Resize(LR, 3)
　　　.Calculate
　　　.Value = .Value
　 End With
　 With Range("L2")
　　　.Value = 2
　　　.AutoFill .Resize(LR), xlLinearTrend
　 End With
　 Range("A1").CurrentRegion.Sort Key1:=Range("H1"), _
　 Order1:=xlDescending, Key2:=Range("I1"), _
　 Order2:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns
　 With Range("K2")
　　　.Value = 1
　　　.AutoFill .Resize(LR), xlLinearTrend
　 End With
　 Range("A1").CurrentRegion.Sort Key1:=Range("L1"), _
　 Order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns
　 Range("L:L").ClearContents
　 Application.ScreenUpdating = True
End Sub

2 hits

▼

【41883】順位のつけ方 てんぱい 06/8/24(木) 22:26