Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4997 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【53180】Ｌａｒｇｅについて あゆたろう 07/12/18(火) 18:20 質問[未読]
【53183】Re:Ｌａｒｇｅについて n 07/12/18(火) 19:14 発言[未読]
【53184】Re:Ｌａｒｇｅについて あゆたろう 07/12/18(火) 19:39 お礼[未読]
【53186】Re:Ｌａｒｇｅについて あゆたろう 07/12/19(水) 1:18 お礼[未読]
【53190】Re:Ｌａｒｇｅについて n 07/12/19(水) 13:16 発言[未読]
【53191】Re:Ｌａｒｇｅについて あゆたろう 07/12/19(水) 13:58 お礼[未読]
【53180】Ｌａｒｇｅについて
質問  あゆたろう E-MAIL  - 07/12/18(火) 18:20 -
引用なし
パスワード
   よろしくお願いします。
Ｘ列は数値です。
Ｘ列の大きい順に優先順位を付けようと以下のようにしましたが、
同数の場合は行の上にあるを優先順位の上位にしたいと思います。
小生勉強中です。Ｌａｒｇｅにはこだわっていません。
過去のスレでは見つかりませんでした。
参考になる過去のスレでも良いです。ヒントを下さい。

Sub test()
Dim LastRow　　As Integer
Dim rNb1roW　　As Long
Dim rNb2roW　　As Long
Dim rNb3roW　　As Long
Dim rNb4roW　　As Long
Dim sPhere　　 As Variant

LastRow = Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Row
sPhere = Range("X4:X" & LastRow)
With Application
　　rNb1roW = Application.Match(.Large(sPhere, 1), sPhere, 0) + 3
　　rNb2roW = Application.Match(.Large(sPhere, 2), sPhere, 0) + 3
　　rNb3roW = Application.Match(.Large(sPhere, 3), sPhere, 0) + 3
　　rNb4roW = Application.Match(.Large(sPhere, 4), sPhere, 0) + 3
End With
End Sub
【53183】Re:Ｌａｒｇｅについて
発言  n  - 07/12/18(火) 19:14 -
引用なし
パスワード
   こんにちは。
もっと良い案がありそうですが、とりあえずの叩き台として一例。

Sub try()
　　Dim LastRow As Long
　　Dim sPhere　As Variant
　　Dim i　　　 As Long
　　Dim x
　　Dim n(1 To 4)

　　LastRow = Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Row
　　sPhere = Range("X4:X" & LastRow)
　　With Application
　　　　For i = 1 To 4
　　　　　　x = .Match(.Max(sPhere), sPhere, 0)
　　　　　　If Not IsError(x) Then
　　　　　　　　n(i) = x + 3
　　　　　　　　sPhere(x, 1) = Empty
　　　　　　End If
　　　　Next i
　　End With
　　Debug.Print Join(n, ",")
End Sub
【53184】Re:Ｌａｒｇｅについて
お礼  あゆたろう E-MAIL  - 07/12/18(火) 19:39 -
引用なし
パスワード
   n さん 早々にありがとうございました。
実は、優先順位は１０位作ろうと思っていましたので大変ありがたいです。
まだこの数値を　Dim rNb1roW　　As Long　にどうやっていくか解りませんが、
出来るはずですのでがんばります。出来たら書き込みます。ありがとうございました。
【53186】Re:Ｌａｒｇｅについて
お礼  あゆたろう  - 07/12/19(水) 1:18 -
引用なし
パスワード
   n さん、本当にありがとうございました。
sPhere(x, 1) = Empty　の理解はあやふやですが、大筋では
理解できました。
理解できた確認の為、コードを書き込ませていただきます。
間違っていたら教えてください。
今後もよろしくお願いします。

Sub 確認()
Dim LastRow As Integer
Dim sPhere　As Variant
Dim i　　　 As Long
Dim x　　　 As String
Dim rNbroW(1 To 10)　 As String

LastRow = Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Row
sPhere = Range("X4:X" & LastRow)
With Application
For i = 1 To 10
　　x = .Match(.Max(sPhere), sPhere, 0)
　　If Not IsError(x) Then
　　　　rNbroW(i) = x + 3
　　　　Cells(x + 3, 24).Select
　　　　MsgBox x + 3 & "が" & i & "番目に大きい行です"
　　　　sPhere(x, 1) = Empty　　'Range("X4:X" & LastRow)から消しちゃう？
　　End If
Next i
End With
End Sub
【53190】Re:Ｌａｒｇｅについて
発言  n  - 07/12/19(水) 13:16 -
引用なし
パスワード
   Sub 確認()
　　Dim LastRow As Integer
　　Dim sPhere　As Variant
　　Dim i　　　 As Long
　　Dim x　　　 As Variant 'String型ではErrorを受けきれない。
　　Dim rNbroW(1 To 10) As Long 'String　'行数なのでLongが素直かな？

　　LastRow = Cells(Rows.Count, 5).End(xlUp).Row 'ActiveSheet.は不要
　　'If LastRow < 5 Then Exit Sub
　　sPhere = Range("X4:X" & LastRow)
　　With Application
　　　　For i = 1 To 10
　　　　　　x = .Match(.Max(sPhere), sPhere, 0)
　　　　　　If Not IsError(x) Then
　　　　　　　　rNbroW(i) = x + 3
　　　　　　　　Cells(x + 3, 24).Select
　　　　　　　　MsgBox x + 3 & "が" & i & "番目に大きい行です"
　　　　　　　　sPhere(x, 1) = Empty　　'Range("X4:X" & LastRow)から消しちゃう？
　　　　　　End If
　　　　Next i
　　End With
End Sub

Rows.CountはApplicationのRows.Countで、BookやSheetによって変わるわけではありませんから、
ActiveSheet.は不要ですね。

>Range("X4:X" & LastRow)から消しちゃう？
の？については、
Range("X4:X" & LastRow)の値を格納した配列sPhereから消します。
『消す』というか、元の値をEmptyにしちゃうわけです。
Max(sPhere)で既に使った値だから次のMax(sPhere)で邪魔になりますね？

VBAの理解にとても役立つツールとして、[ローカルウィンドウ]があります。
://excelvba.pc-users.net/fol8/8_2.html
ワンステップずつ実行しながら、変数の 値 や 型 を確認すると理解が深まりますよ。
【53191】Re:Ｌａｒｇｅについて
お礼  あゆたろう  - 07/12/19(水) 13:58 -
引用なし
パスワード
   n さん、丁寧に解説していただきありがとうございます。
まだ、『マクロの記録』を使用しながらの作成ですので'ActiveSheet.が
入ったり、[ローカルウィンドウ]を知らなかった（使わなかった）ので
ブレークポイントで止めてカーソルを合わして色々確認してました。
>://excelvba.pc-users.net/fol8/8_2.html
は、お気に入りに追加し勉強していきます。
ありがとうございました。
ここでの、簡単な質問にも答えようと思っています。
ミスっていたらご指摘をお願いします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4997 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free