[[20190110081905]]　『列方向でRANK』（819）　ページの最後に飛ぶ

『列方向でRANK』（819）

恐れ入ります。
S列からAJ列の1行目に順位　1,2,3・・・18があり
2行目から数字が有ります。データ数は約55000行あります。

1行目を基準に列方向に　worksheet　function　rank　で
データの順位を知りたいのです。

列　S 　　T　　　U　　　V　　　W　　　X　　　Y　　　Z　　・・・
　　75　　74　　72　　　73　　71　　　70　　　68　　69　・・・

処理として
U列　　　数字右詰　フォントサイズ15
V列　　　数字左詰　フォントサイズ15
Y列　　　数字右詰　フォントサイズ15
Z列　　　数字左詰　フォントサイズ15

下処理としてSからAJ列の2行目から下の数字を中央揃えにする。　？

私の頭ではどの様に記述してよいか分からず悩んでおります。
皆様の知恵をお貸しいただけないでしょうか？
よろしくお願いいたします。

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

 １行目の順位と

 ＞1行目を基準に列方向に　worksheet　function　rank　で 
 ＞データの順位を知りたいのです。 
 って何が違うんですか？

 やりたいことがさっぱりわからないです。
（稲葉） 2019/01/10(木) 09:06

 RANKと書式にどんな関係があるのかもわからんね。
（GobGob） 2019/01/10(木) 09:12

稲葉様、GobGob様
コメントありがとうございます。

説明がへたですみません。
worksheet　function　rankこれは最近そちらのサイトで閲覧したときに載っていたものなので
関係あるのかと思いまして使ってしまいました。忘れて頂いて結構です。

S列からAJ列の1行目に記されている数字は順位でそれに対して
2行目からの数字をを列方向にソートせず上にあるのか下にあるのかを判断出来る様にしたいのです。
その数字が本来の順位（1行目）に対して
上位なら左詰め
下位なら右詰め
他は中央揃え

上司からの無茶振りなのでどういう数字か分かりません。只条件の処理を聞いただけなのですみません。

処理はの可能でしょうか？

（819） 2019/01/10(木) 10:03

 数値の順位は昇順での順位か降順での順位かどちらだろうか？

（ねむねむ） 2019/01/10(木) 10:10

 条件付き書式で

 =RANK(S2,$S2:$AJ2,FALSE)<=S$1

 表示形式「文字列」

 ・数値がでかい = ランク上位
 ・同ランク = ランク上位処理

（GobGob） 2019/01/10(木) 10:19

 あっ、他ってのがあるのね…
 中央揃えには対応してません。
（GobGob） 2019/01/10(木) 10:33

ねむねむ様
コメントありがとうございます。
数値の順位は降順での順位でお願いします。

GobGob様
頂いた書式試してみます。

（819） 2019/01/10(木) 10:42

 中央揃えは右揃え、左揃えと区別できればいい（＆列幅はみな同じ）であれば
 G/標準___ （_はスペース）
 でも構わないのでは？

（ねむねむ） 2019/01/10(木) 11:14

ねむねむ様
コメントありがとうございます。
何分、上司の要望なので・・・
どうにかなりませんか？

よろしくお願いいたします。
（819） 2019/01/10(木) 11:21

 S列からAJ列を選択して条件付き書式で
 条件1：=AND(ROW()>1,RANK(S1,$S1:$AJ1,0)=S$1)
 書式1：ユーザー定義で　G/標準____
 _はスペース、個数は調節してくれ。
 条件2：=AND(ROW()>1,RANK(S1,$S1:$AJ1,0)<S$1)
 書式2：文字列
 ではどうか？
（ねむねむ） 2019/01/10(木) 11:44

 ５万行の書式を変更するのめんどくさいので、矢印にしちゃいました。
 考え方あってます？
    Option Explicit
    Sub test()
        Dim tbl As Variant
        Dim w   As Variant
        Dim i As Long
        Dim j As Long
        tbl = Range("S2", Cells(Rows.Count, "AJ").End(xlUp)).Value
        ReDim w(1 To UBound(tbl, 2))
        For i = 1 To UBound(tbl)
            For j = 1 To UBound(tbl, 2)
                w(j) = tbl(i, j)
            Next j
            Call bsort(w)
            For j = 1 To UBound(tbl, 2)
                Select Case True
                    Case tbl(i, j) = w(j): tbl(i, j) = "→" & tbl(i, j)
                    Case tbl(i, j) > w(j): tbl(i, j) = "↓" & tbl(i, j)
                    Case tbl(i, j) < w(j): tbl(i, j) = "↑" & tbl(i, j)
                End Select
            Next j
        Next i
        Range("S2", Cells(Rows.Count, "AJ").End(xlUp)).Value = tbl
    End Sub
    Private Sub bsort(ByRef w As Variant)
        Dim i As Long
        Dim j As Long
        Dim n As Long
        For i = LBound(w) To UBound(w)
            For j = LBound(w) + 1 To UBound(w) - i + LBound(w)
                If w(j) < w(j - 1) Then
                    n = w(j)
                    w(j) = w(j - 1)
                    w(j - 1) = n
                End If
            Next j
        Next i
    End Sub
    Sub reset()
        With Range("S2", Cells(Rows.Count, "AJ").End(xlUp))
            .Replace "→", ""
            .Replace "↑", ""
            .Replace "↓", ""
        End With
    End Sub

（稲葉） 2019/01/10(木) 11:52

ねむねむ様、稲葉様
コメント、書式及びコードありがとうございます。

申し訳ございません。

上司に見せたところ却下されました。
以前、条件付き書式で大変だったから却下され
矢印だとなんだか判らないとのコメントでした。

もう一度確認確認の意味で条件を提示します。

S2からAJ2が一つの塊で次が
S3からAJ3
S4からAJ4
S5からAJ5　
　　・
　　・
　　・
S55000からAJ55000

これを列方向に降順ソートして並べ替えたいのですが
基のデータは変えられないので順位が異なっている所に
フォントサイズを変え左右に振ると言う事にしたのです。

　　1行目　2行目…
S列　1　　　75
T列　2　　　74
U列　3　　　　71　セル左詰　　
V列　4　　　　72　セル左詰
W列　5　　73　　　セル右詰
X列　6　　　69　
　　・
　　・
　　・
AJ列　18　　50

新たにトピを立てた方が良いのでしょうか？

（819） 2019/01/10(木) 14:04

 この程度で新しいスレなんていらんでしょ。
 矢印付けた後、矢印をFindで検索して書式変更していくってやりかたで試してみましたけど
 ５０００行でもかなり時間かかったから、５万なんて持つかどうかわからんです。

 ２０分くらい放置してみてください。

    Sub reset()
        Dim r As Range
        Dim f As Range
        Dim ff As String
        Dim moji As Variant
        Dim cnt As Long
        With Range("S2", Cells(Rows.Count, "AJ").End(xlUp))
            .HorizontalAlignment = xlCenter
            For Each moji In Array("↑", "↓")
                Range("S2").Activate
                Set r = Nothing
                cnt = 1
                Set r = .Find(moji)
                If Not r Is Nothing Then
                    ff = r.Address
                    cnt = 1
                    Set f = r
                    Do
                        Set f = .FindNext(f)
                        If f.Address = ff Then Exit Do
                        Set r = Union(r, f)
                        cnt = cnt + 1
                        If cnt > 500 Then
                            Call 書式設定(r, moji)
                            cnt = 1
                            Set r = f
                            DoEvents
                        End If
                    Loop
                    If Not r Is Nothing Then Call 書式設定(r, moji)
                End If
            Next moji
            .Replace "→", ""
            .Replace "↑", ""
            .Replace "↓", ""
        End With
    End Sub
    Sub 書式設定(r As Range, ByVal 矢印 As String)
        Select Case 矢印
            Case "↑": r.HorizontalAlignment = xlRight
            Case "↓": r.HorizontalAlignment = xlLeft
        End Select
    End Sub

（稲葉） 2019/01/10(木) 15:04

稲葉様
処理を実行したところ処理そのものが違います。
すべてに矢印が付いてしまいます。
本来S列には矢印は付かないのですがついてしまいます。
（819） 2019/01/10(木) 16:20

 ＞本来S列には矢印は付かないのですがついてしまいます。
 一番最初と（819） 2019/01/10(木) 14:04　ではやることが違うってことですか？
 少なくとも、　　　~~~~~~~~~~~~~~~~~~~~ではあっていたという認識でいいんですか？

（稲葉） 2019/01/10(木) 16:26

稲葉様

すみません最初にコードを走らせていたは課長が隣にいて緊張して確認を怠っていました。
その後確認でコードを走らせたら違うことに気づきました。

当方の確認ミスで申し訳ございませんでした。

（819） 2019/01/10(木) 17:45

 ＞本来S列には矢印は付かないのですがついてしまいます。
 他の回答者もS列に書式設定していますが、そちらも誤りということですか？

 仮に書式でやるとしても、文字だけだとわかりにくいので、
 左寄せは頭に＋　右寄せは頭に－を付けて、下記のデータでどうなればいいか教えていただけますか？
 １）範囲をコピーして、S1に張り付け
 ２）S列を範囲選択して、セルの区切り位置、スペース
 ３）加工した結果を、何も装飾せず、コメントに張り付けてください。

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
52 26 69 57 37 52 43 74 79 99 57 81 25 38 81 9 77
45 48 75 34 52 57 76 55 7 30 84 58 45 46 70 27 59 32
75 37 47 68 17 13 83 80 71 13 12 6 55 89 45 69 52 48

（稲葉） 2019/01/10(木) 18:08

稲葉様
申し訳ありませんがPCを子供達が使うのでまた明日からにしてください。
（819） 2019/01/10(木) 19:36

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
　-52 -26 -69 -57 -37 -52 -43 +74 +79 +99 +57 +81 -25 -38 +81 -9 +77
　-45 -48 +75 -34 -52 -57 +76 55 -7 -30 +84 +58 45 +46 +70 -27 +59 +32
　-75 -37 -47 -68 -17 -13 +83 +80 +71 -13 -12 -6 +55 +89 +45 +69 +52 +48
稲葉様
上記の様になりました。
一つ言い忘れが有りました。数値は右肩下がりです。
（819） 2019/01/11(金) 08:26

 ＞一つ言い忘れが有りました。数値は右肩下がりです。
 順番になっていなければ、右肩下がりだろうが関係なくないですか？

 あと
 ＞本来S列には矢印は付かないのですがついてしまいます。
 ＞（819） 2019/01/10(木) 16:20
 この部分がいまだにわかりません。

 いただいたデータをもとに、コード直しました。
 すべて差し替えてください。
 データの1行目（52,26,69・・・）は途中で空白セルがあったので、2行目で検証しました。
 基本的な考え方は変わっていません。
 一度矢印で目印つけて、あとで（reset）で書式設定する方法です。

 これでダメなら、私の手に負えそうにないので、辞退します。

    |[R]     |[S] |[T] |[U] |[V] |[W] |[X] |[Y] |[Z] |[AA]|[AB]|[AC]|[AD]|[AE]|[AF]|[AG]|[AH]|[AI]|[AJ]
 [1]|順位    |   1|   2|   3|   4|   5|   6|   7|   8|   9|  10|  11|  12|  13|  14|  15|  16|  17|  18
 [2]|元データ|  45|  48|  75|  34|  52|  57|  76|  55|   7|  30|  84|  58|  45|  46|  70|  27|  59|  32
 [3]|稲葉    |－45|－48|＋75|－34|－52|－57|＋76|＋55| －7|－30|＋84|＋58|＋45|＋46|＋70|－27|＋59|＋32
 [4]|819様   |－45|－48|＋75|－34|－52|－57|＋76|＋55| －7|－30|＋84|＋58|＋45|＋46|＋70|－27|＋59|＋32
 [5]|Large   |  84|  76|  75|  70|  59|  58|  57|  55|  52|  48|  46|  45|  45|  34|  32|  30|  27|   7
 [6]|Rank    |  12|  10|   3|  14|   9|   7|   2|   8|  18|  16|   1|   6|  12|  11|   4|  17|   5|  15

    Option Explicit
    Sub test()
        Dim tbl As Variant
        Dim w()   As Long
        Dim i As Long
        Dim j As Long
        tbl = Range("S2", Cells(Rows.Count, "AJ").End(xlUp)).Value
        ReDim w(1 To UBound(tbl, 2))
        For i = 1 To UBound(tbl)
            For j = 1 To UBound(tbl, 2)
                w(j) = tbl(i, j)
            Next j
            Call bsort(w)
            For j = 1 To UBound(tbl, 2)
                Select Case True
                    Case tbl(i, j) = w(j): tbl(i, j) = "" & tbl(i, j)
                    Case tbl(i, j) > w(j): tbl(i, j) = "←" & tbl(i, j)
                    Case tbl(i, j) < w(j): tbl(i, j) = "→" & tbl(i, j)
                End Select
            Next j
        Next i
        Range("S2", Cells(Rows.Count, "AJ").End(xlUp)).Value = tbl
    End Sub
    Private Sub bsort(ByRef w() As Long)
        Dim i As Long
        Dim j As Long
        Dim n As Long
        For i = LBound(w) To UBound(w)
            For j = LBound(w) + 1 To UBound(w) - i + LBound(w)
                If w(j) > w(j - 1) Then
                    n = w(j)
                    w(j) = w(j - 1)
                    w(j - 1) = n
                End If
            Next j
        Next i
    End Sub
    Sub reset()
        Dim r As Range
        Dim f As Range
        Dim ff As String
        Dim moji As Variant
        Dim cnt As Long
        With Range("S2", Cells(Rows.Count, "AJ").End(xlUp))
            .HorizontalAlignment = xlCenter
            For Each moji In Array("←", "→")
                Range("S2").Activate
                Set r = Nothing
                cnt = 1
                Set r = .Find(moji)
                If Not r Is Nothing Then
                    ff = r.Address
                    cnt = 1
                    Set f = r
                    Do
                        Set f = .FindNext(f)
                        If f.Address = ff Then Exit Do
                        Set r = Union(r, f)
                        cnt = cnt + 1
                        If cnt > 500 Then
                            Call 書式設定(r, moji)
                            cnt = 1
                            Set r = f
                            DoEvents
                        End If
                    Loop
                    If Not r Is Nothing Then Call 書式設定(r, moji)
                End If
            Next moji
            .Replace "←", ""
            .Replace "→", ""
        End With
    End Sub
    Sub 書式設定(r As Range, ByVal 矢印 As String)
        Select Case 矢印
            Case "→": r.HorizontalAlignment = xlRight
            Case "←": r.HorizontalAlignment = xlLeft
        End Select
    End Sub
（稲葉） 2019/01/11(金) 10:00

稲葉様

残念ながら結果が違いました。
長い時間付き合って頂きありがとうございました。
（819） 2019/01/11(金) 13:48

 こちらこそ、お役に立てず申し訳ありません。
（稲葉） 2019/01/11(金) 14:29

コメント返信：

[ 一覧(最新更新順) ]

[[20190110081905]] 『列方向でRANK』（819） ページの最後に飛ぶ

[[20190110081905]]　『列方向でRANK』（819）　ページの最後に飛ぶ