RNKU関数をマクロで記述したいのですが？

質問

RNKU関数をマクロで記述したいのですが？

マクロを勉強しようと思いネットや本を見ながら試行錯誤しております。RANK関数と同じことをしようと思い調べながら実行したのですがうまくいきません。型が一致しませんと出るのですが、ヘルプを見ても良く分からなかったので、だれか教えて頂けませんでしょうか。
Sub Macro1()
Range("A1:A17").Select
For Each r In Selection
Range("B1:B17") = Application.WorksheetFunction.Rank(r, Selection, 1)
Next r
End Sub

A列の順位をB列に表示しようとしました。

回答No.2

xls88 · ベストアンサー

＞途中まで実行できるようになりました。
上手く対処できたみたいで喜ばしいのですが
どういうデータがあったのですか？
どのように対処されたのですか？

＞ワークシート関数のようにA1:A17の間のセルに空欄があると途中で止まってしまいます。
＞空欄を無視するみたいな記述が必要ということでしょうか？
その通りです。
If文で条件分岐する例です。

If r.Value <> "" Then
・
・処理
・
End If

＞Selectしない書き方も本を見ながら研究してみます。
ヒント
Selection = Range("A1:A17")

あと変数の宣言もするようにした方が良いですよ。
Dim r As Range

For Each r In Selection
・
Next r

お礼

xls88様
有難うございます。やりたい事ができました。本当に感謝しております。
とても勉強になりました。また、ヒントまで頂きましてありがとうございます。
また、お世話になるかも知れませんがその時は、宜しくお願いします。

回答No.3

Wendy02

RNKU関数　とは、RANK関数だと思います。
>RANK関数と同じことをしようと思い調べながら
マクロの勉強中としたら、こういう勉強は、最終コーナーだと置います。入門程度ではでは歯が立たないと思います。

そのご質問は、RANK関数を利用して、表示するということだと思います。

>Range("B1:B17") = Application.WorksheetFunction.Rank(r, Selection, 1)
うまく行かない理由は、Rank関数は、ひとつの値であって、配列は返しません。

Sub Macro1()
Dim rng As Range
　　　Set rng = Range("A1:A17")
　　　With rng.Offset(, 1)
　　　　 .Formula = "=RANK(RC[-1]," & rng.Address(, , xlR1C1) & ", TRUE)"
　　　　 .Value = .Value
　　　　 On Error Resume Next
'エラー値を抜く
　　　　 .SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
　　　　 On Error GoTo 0
　　　End With
End Sub

余計なことかもしれませんが、RANK関数と同じことをさせるなら、こういうことだと思います。
空欄にエラーを出させる代わりに、"" (空白値）を出すことにしました。
なかなか、難しいです。

Function myRANK(v, rng as Range, Optional flg As Boolean)
　Dim ret As Long
　Dim i As Long, j As Long
　Dim ar As Variant
　Dim arTmp As Variant
　If rng.Rows.Count > 1 And rng.Columns.Count > 1 Then Exit Function
　If TypeName(v) = "Range" Then
　　 If IsEmpty(v.Value) Then myRANK = "": Exit Function
　End If
　If rng.Columns.Count = 1 Then
　　ar = Application.Transpose(rng.Value)
　Else
　　ar = Application.Index(rng.Value, 1, 0)
　End If
　 arTmp = ar
　 j = LBound(ar)
　For i = LBound(ar) To UBound(ar)
　　If ar(i) <> "" Then
　　 arTmp(j) = ar(i)
　　 j = j + 1
　　End If
　Next i
　ReDim Preserve arTmp(j - 1)
　ar = arTmp
　BubbleSortNumbers ar
　If flg Then
　　For i = 1 To UBound(ar)
　　　If ar(i) = v Then
　　　　ret = i
　　　　Exit For
　　　End If
　　Next i
　Else
　　j = 1
　　For i = UBound(ar) To 1 Step -1
　　　If ar(i) = v Then
　　　　ret = j
　　　　Exit For
　　　End If
　　　j = j + 1
　　Next i
　End If
　If flg Then
　　myRANK = i
　Else
　　myRANK = j
　End If
End Function
Private Function BubbleSortNumbers(ByRef ar As Variant)
　Dim x As Long
　Dim y As Long
　Dim Tmp As Long
　For x = UBound(ar) To LBound(ar) Step -1
　　For y = LBound(ar) + 1 To x
　　　If ar(y - 1) > ar(y) Then
　　　　Tmp = ar(y - 1)
　　　　ar(y - 1) = ar(y)
　　　　ar(y) = Tmp
　　　End If
　　Next y
　Next x
End Function

お礼

Wendy02様
有難うございます。
＞そのご質問は、RANK関数を利用して、表示するということだと思います。
最初、意味が分かりませんでしたが、調べてみると意味が理解できました。
ワークシート関数とマクロで同じことをさせる事は、まさしく最終コーナーです。
少しづつ勉強していきます。

回答No.1

xls88

rのデータが数値ではないということでは？
★1、IsNumericでFalseが返されませんか？
★2、代入式の左辺がおかしいので書き直しました。

Sub Macro1()
Range("A1:A17").Select
For Each r In Selection
Msgbox IsNumeric(r.Value)　'★1
r.Offset(, 1).Value = Application.WorksheetFunction.Rank(r, Selection, 1)　'★2
Next r
End Sub

あと
Select
しない書き方も研究してください。

補足

xls88様有難うございます。
途中まで実行できるようになりました。
ただ、ワークシート関数のようにA1:A17の間のセルに空欄があると途中で止まってしまいます。
これは、空欄を無視するみたいな記述が必要ということでしょうか？
あと、Selectしない書き方も本を見ながら研究してみます。有難うございます。