15文字を超える文字列のランク付け方法

質問

いつもお世話になっております。

Office2007にて、ExcelVBAでプログラムを組んでいるのですが、
現在、15文字を超える文字列の並べ替えについていい方法が浮かばず
悩んでおります。

例えば、以下のケースにおいて、B列に、A列の長い文字列の大小関係を
判定して、RANK関数のように順位を表示させたいのですが、名案が中々
浮かびません。文字列長15桁を超えてしまうと、様々な関数が機能しないようです。

　　　　　　　　　　　　　　A　　　　　　　　　　　　　　　　　　　　　　　　B
1234567890123456789012345678901234567890
0987654321098765432109876543210987654321
6789012345678901234567890123456789012345
　　　　　　　　　　　　　・・・

⇒
　　　　　　　　　　　　　　A　　　　　　　　　　　　　　　　　　　　　　　　B
1234567890123456789012345678901234567890　　　　　　　　2
0987654321098765432109876543210987654321　　　　　　　　1
6789012345678901234567890123456789012345　　　　　　　　3
　　　　　　　　　　　　　・・・

昨日半日悩んでしまい非常に困っています。
どなたかご教授いただければ幸いです。

回答No.8

MackyNo1 · ベストアンサー

>余計なお世話かもしれませんが、No5さんの場合、同じ数値だと順位は高い方にまとめられますね。

コメントありがとうございます。
確かにご指摘の通り同順位の表示の仕方が誤っていますね（検証不足でした）。

数式を以下のように変更すれば、同順位でもRANK関数と同じ正しい順位が表示できます。

=SUMPRODUCT(($A$1:$A$100<A1)*($A$1:$A$100<>""))+1

必要に応じて空白セル対策などをしてください。

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。

＃一番シンプルな方法で、今回採用をさせていただいたため、
＃ベストアンサーとさせていただきました。

回答No.9

nishi6

添付図の状態で、シート上ならRankは、
　　=SUMPRODUCT(--($A$1:$A$3<=A3))
と書けます。（昇順です。質問での順位づけのルールが若干？ですが）

これをユーザー定義関数で書くと以下のようになりました。
TargetがRankを求めたいセル、AllRangeが順位を決める全対象セルです。

Function myRankLong(Target As Range, AllRange As Range) As Integer
　　Dim rg As Range

　　For Each rg In AllRange
　　　　myRankLong = myRankLong - (rg.Value <= Target.Value) * 1
　　Next
End Function

ご参考に。

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。

回答No.7

kkkkkm

余計なお世話かもしれませんが、No5さんの場合、同じ数値だと順位は高い方にまとめられますね。

順位付けしたい値が

1
1
2
3

だと

2
2
3
4

とう結果になります。

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。

回答No.6

kkkkkm

No3No4です

自作関数でしたらスピードは遅いかもしれませんが…

Function MyRank(SelectRange As Range, FindRange As Object) As Variant
Dim i As Long, j As Long
Dim buf As Variant, Mydata As Variant

Mydata = FindRange

For i = 1 To FindRange.Count
For j = FindRange.Count To i Step -1
If Mydata(i, 1) > Mydata(j, 1) Then
buf = Mydata(i, 1)
Mydata(i, 1) = Mydata(j, 1)
Mydata(j, 1) = buf
End If
Next j
Next i
For i = 1 To UBound(Mydata)
If Mydata(i, 1) = SelectRange.Value Then
MyRank = i
Exit For
End If
Next
End Function

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。

回答No.5

MackyNo1

文字列（数字）のＲＡＮＫ関数に相当する式は以下のような数式で代用できます。

=SUMPRODUCT(($A$1:$A$100<=A1)*($A$1:$A$100<>""))

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。

回答No.4

kkkkkm

No3です。

i = 1
For i = i To UBound(Mydata)

無意味な事してました。チェックの時の残骸を始末できないでいただけですので普通に

For i = 1 To UBound(Mydata)

でお願いします。

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。

回答No.3

kkkkkm

こんな感じでいけないでしょうか

Sub Example()
Dim i As Long, j As Long, EndRow As Long
Dim buf As Variant, Mydata As Variant
Dim c As Range
Dim firstAddress As String

EndRow = Range("A" & Rows.Count).End(xlUp).Row
Mydata = Range(Cells(1, "A"), Cells(EndRow, "A"))

For i = 1 To EndRow
For j = EndRow To i Step -1
If Mydata(i, 1) > Mydata(j, 1) Then
buf = Mydata(i, 1)
Mydata(i, 1) = Mydata(j, 1)
Mydata(j, 1) = buf
End If
Next j

Next i
i = 1
For i = i To UBound(Mydata)
With Range(Cells(1, "A"), Cells(EndRow, "A"))
Set c = .Find(CStr(Mydata(i, 1)), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Cells(c.Row, "B").Value = i
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next
End Sub

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。

回答No.2

RandenSai

自前で大小比較の関数を自作するとしても、力技で良ければとても単純な処理になります。以下の関数は、渡された二つの値（文字列で表記された数値）の大小を比較し、大きい方を返す物です。文字列で受けているので、桁数は文字列型変数の長さが許す限り受け付けます。

ただし全く動作は確認していないことと、数値以外の値が渡された場合のエラーチェックは一切していないため、動かない可能性はありますが、概念説明にはなるでしょう。またこれは二つしか比較していませんが、変数を増やせば三つやそれ以上の比較も出来ますし、関数ではなくサブルーチンにして、グローバル変数の配列を参照するようにすればもっと柔軟になるでしょう。

Private Function CmpVal(ByVal,val1 As String,ByVal val2 As String) As String

i As Integer
cscore1 As Integer,cscore2 As Integer '比較結果スコアの変数

'引数の長さを揃える
If Len(val1) < Len(val2) Then
val1 = Right(String(Len(val2),"0") & val1 , Len(val2))
Else
val2 = Right(String(Len(val1),"0") & val2 , Len(val1))
End If

'大小を確認するループ
'先頭から1文字ずつ取り出して数値に変換し、大小を比較する
'桁数に応じてスコアを加算する
For i = 1 To Len(val1)
If Val(Mid(val1,i,1)) > Val(Mid(val2,i,1)) Then
cscore1 = cscore1 + (Len(val1) - i + 1)
Else
cscore2 = cscore2 + (Len(val1) - i + 1)
End If
Next

'最終判定
If cscore1 > cscore2 Then
CmpVal = val1
Else
CmpVal = val2
End If

End Function

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。

回答No.1

neKo_deux

普通に辞書順の比較しては？

MsgBox """0987654321098765432109876543210987654321"" < ""1234567890123456789012345678901234567890""" & ("0987654321098765432109876543210987654321" < "1234567890123456789012345678901234567890")

比較できれば、ソートに応用できるし。

> 文字列長15桁を超えてしまうと、様々な関数が機能しないようです。

文字列でなくて、数値として処理していませんか？
Excel、VBAで扱える数値の桁数は15桁までだったハズ。

お礼

皆様ご回答ありがとうございました。
おかげさまで、無事この問題を乗り切れそうな目処が立ちました。

厚く御礼申し上げます。