[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セル内で使われた数字の整理』（さっぱりダメ）
質問内容
たとえばランダムな数字がＡ列に入っていて
Ｂ列で
Ａ列で使われた数字を、重複しないように整理し
さらに昇降順に並び替える
というのは可能でしょうか？
Ａ Ｂ
1 123456 123456
2 115235 1235
3 567583 35678
4 28 28
5 98776354 3456789
Ｂ列で並び替えまで同時にするのが難しければ
さらに横のＣ列で並び替えとしても、差し支えはありません。
ＳＵＭとＣＯＵＮＴくらいしか関数を使ったことがなくて
やり方があるのかわかりませんでした。
どなたか教えてくださるととても嬉しいです。
おはようございま〜す。。。♪
一般機能のフィルタオプションの設定を 使ってみてはいかがでしょうか？
重複しないリストを作る(フィルタオプションの設定)
http://www.geocities.jp/chiquilin_site/data/060314_integrated_list.html
その上で
>昇降順に並び替える
ご参考にどうぞ。。
。。。Ms.Rin〜♪
VBAでの処理になると思いますので、ユーザー定義関数を作成してみます。
Alt+F11でVBEを開き、挿入→標準モジュールに下のコードをコピー&貼り付けします。
B1セルには=suji(A1) と入力します。 (Hatch)
Function suji(c As Range)
Dim i As Integer
For i = 1 To 10
If c.Value Like "*" & Right(i, 1) & "*" Then
suji = suji & Right(i, 1)
End If
Next i
suji = suji * 1
End Function
だるまです。 http://hp.vector.co.jp/authors/VA033788/index.html
>さらに昇降順に並び替える それは難しいですね。昇順か降順なら可能ですが。^d^
あら〜ツ！！
Hatchさんの回答みたら。。。
なるほど、そういう事だったんですね。。
質問をよく読まずに、カン違い。。 トンチンカンな、回答で失礼しました〜♪
> VBAでの処理になると思いますので
Hatchさんのおしゃる通り、数式ではチョット無理ですね。。。
。。。Ms.Rin〜♪♪
だるまです。 http://hp.vector.co.jp/authors/VA033788/index.html
茶茶だけでは何なので、フィルタオプションを使わないバージョンのコードです。^d^
Sub Hogehoge()
Dim RR As Range
Dim V As Variant
Set RR = Range("A1")
Set RR = Range(RR, RR.End(xlDown))
V = GetSummary(RR)
V = Application.WorksheetFunction.Transpose(V)
With RR.Offset(, 1)
.ClearContents
.Resize(UBound(V)).Value = V
End With
End Sub
'Rangeを受け、重複の無い一次元配列を返す
Private Function GetSummary(RR As Range) As Variant
'返す配列の添え字下限は0
Dim R As Range
Dim Dic As Object
Dim K As Variant
Dim V As Variant
Set Dic = CreateObject("Scripting.Dictionary")
For Each R In RR.Cells
K = R.Value
If K <> "" Then
Dic(K) = Empty
End If
Next
V = Dic.keys
Set Dic = Nothing
GetSummary = Csort(V) '並べ替え不要ならCsort()は不要
End Function
Private Function Csort(ByVal Target As Variant) As Variant
'昇順並べ替え、引数は１次元配列のみ可
Dim L As Long
Dim U As Long
Dim i As Long
Dim gap As Long
Dim Temp As Variant
Dim F As Boolean
L = LBound(Target)
U = UBound(Target)
gap = U - L
F = True
Do While gap > 1 Or F = True
gap = Int(gap / 1.3)
If gap = 9 Or gap = 10 Then
gap = 11
ElseIf gap < 1 Then
gap = 1
End If
F = False
For i = L To U - gap
If Target(i) > Target(i + gap) Then
Temp = Target(i)
Target(i) = Target(i + gap)
Target(i + gap) = Temp
F = True
End If
Next
Loop
Csort = Target
End Function
削除・・・m(__)m (by Hatch)
◆関数による方法です ◆ただし、１回では出来ないので２列になりました A B C 1 123456 6543210 123456 2 115235 503210 1235 3 567583 876503000 35678 4 28 800000200 28 5 98776354 9876543000 3456789
B1=SUM(IF(ISNA(MID(A1,MATCH(ROW($1:$9),--MID(A1,ROW($1:$9),1),0),1)),0,MID(A1,MATCH(ROW($1:$9),--MID(A1,ROW($1:$9),1),0),1)*10^(ROW($1:$9)))) ★この式は「配列数式」です。式を入力後、Ctrl＋Shift＋Enter をおして、式を確定させてください。 ★確定すると、式の両端に｛ ｝がつきます。 ★確定させてから下にコピー
C1=SUM(LARGE(MID(B1,ROW(INDIRECT("1:"&LEN(B1))),1)*1,ROW(INDIRECT("1:"&LEN(B1))))*10^(ROW(INDIRECT("1:"&LEN(B1)))-1))
★この式も「配列数式」です。同じように式を入力後、Ctrl＋Shift＋Enter をおして、式を確定させてください。
★確定すると、式の両端に｛ ｝がつきます。
★確定させてから下にコピー
(Maron)
Maronさん こんにちは〜♪
おひさしぶり〜です！！。。。 私は、ムリそうでしたので考えもしなかったですが
さすが〜！！私の先生。。 なるほどです。。
最近、あまり回答をお見かけしませんので。。 もっと、いらして下さいネ。。。
関係ないレスでゴメンナサイ。。
。。。Ms.Rin〜♪♪
◆Ms.Rinさん、ご無沙汰しています ◆最近は回答しようと思ったら、すでに回答済みで、皆さんの回答を参考にさせていただいています ◆遅くなりましたが、１回で出来ました ◆0を考慮し、前に0を表示させるなら、文字列になりますが A B 1 115235 1235 2 567583 35678 3 208 028 4 710017 017
B1=IF(ISNUMBER(FIND(0,A1)),0,"")&SUBSTITUTE(SUM(IF(ISNA(MID(A1,MATCH(ROW($1:$9),--MID(A1,ROW($1:$9),1),0),1)),0,MID(A1,MATCH(ROW($1:$9),--MID(A1,ROW($1:$9),1),0),1)*10^(10-(ROW($1:$9))))),0,"")
★もちろんこの式も「配列数式」です
◆0 を後ろに表示させるなら A B 1 115235 1235 2 567583 35678 3 208 280 4 710017 170
B1=SUBSTITUTE(SUM(IF(ISNA(MID(A1,MATCH(ROW($1:$9),--MID(A1,ROW($1:$9),1),0),1)),0,MID(A1,MATCH(ROW($1:$9),--MID(A1,ROW($1:$9),1),0),1)*10^(10-(ROW($1:$9))))),0,"")*10^(ISNUMBER(FIND(0,A1)))
★「配列数式」です (Maron)
数字だけだったら、2次元配列を使用して
Sub test()
Dim a(), b(), i As Long, n As Long, myOrder As Long
a = Range("a1").CurrentRegion.Resize(,1).Value
ReDim b(1 To UBound(a,1), 1 To 1)
myOrder = Application.InputBox("昇順=1, 降順=0",type:=1) '<- 変更
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a,1)
If (a(i,1) <> "") * (Not .exists(a(i,1))) Then
n = n + 1
b(n,1) = Val(a(i,1))
.add a(i,1), Nothing
End If
Next
End With
If n > 0 Then
VSortM b, 1, n, 1, myOrder
Range("b1").Resize(n).Value = b
End If
End Sub
Sub VSortM(ary, LB, UB, ref, myOrd As Long) '<- 変更
Dim i As Long, ii As Long, iii As Long, M, temp
i = UB : ii = LB
M = ary(Int((LB+UB)/2),ref)
Do While ii <= i
If myOrd <> 0 Then '<- 変更
Do While ary(ii,ref) < M : ii = ii + 1 : Loop
Do While ary(i,ref) > M : i = i - 1 : Loop
Else
Do While ary(ii,ref) > M : ii = ii + 1 : Loop
Do While ary(i,ref) < M : i = i - 1 : Loop
End If
If ii <= i Then
For iii = LBound(ary,2) To UBound(ary,2)
temp = ary(ii,iii) : ary(ii,iii) = ary(i,iii) : ary(i,iii) = temp
Next
i = i - 1 : ii = ii + 1
End If
Loop
If LB < i Then VSortM ary, LB, i, ref, myOrd
If ii < UB Then VSortM ary, ii, UB, ref, myOrd
End Sub
(seiya)
修正箇所あり
タイトルとご説明のサンプルからでは
一つのセルの値に関して
＞重複しないように整理し
＞さらに昇降順に並び替える
だけで良いように思いますので、私も
ユーザー定義関数で
'----
Function kzn(kz As Range)
Dim i As Integer, x(10)
For i = 1 To Len(kz.Value)
x(Mid(kz.Value, i, 1)) = Mid(kz.Value, i, 1)
Next i
kzn = (Join(x, "") & x(0)) * 1
End Function
'----
ちなみに、seiyaさんのは コンパイルエラー「ByRef 引数の型が一致しません。」 が表示され ＞ VSortM a, 1, n, 2, myOrder の内 [myOrder]が反転（灰色）します。
(HANA)
HANAさん同もです。 修正してみました。 (seiya)
ん？seiyaさん、これってどの様に成れば良いのですか？ ↓の様になりますが・・・。 [A] [B] [1] 123456 115235 [2] 115235 567583 [3] 567583 28 [4] 28 115235 [5] 98776354 123456 [6] 115235 567583 [7] 567583 98776354 [8] 208 280 [9] 710017 170
(HANA)
げっ... b(), n を宣言しておきながら、頓珍漢なことをしていました... 修正しました。 (seiya)
この質問は、HANAさんの例でしたら、以下のようになればいいのかな？
だるまさん、seiyaさんとは解釈が違っているようですが・・・
上までの回答を以下のコードに変更しておきます。なお、上の回答&コードは削除(^^ゞさせていただきました。
(Hatch)
A B
1 123456 28
2 115235 170
3 567583 280
4 28 1235
5 98776354 35678
6 115235 123456
7 567583 3456789
8 208
9 710017
だるまさん、seiyaさんのコードを実行すれば↓のようになります。
A B
1 123456 28
2 115235 208
3 567583 115235
4 28 123456
5 98776354 567583
6 115235 710017
7 567583 98776354
8 208
9 710017
Sub test99()
Dim x, y, z, myCnt
Dim i As Long, j As Long, lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
x = Range(Cells(1, 1), Cells(lastRow, 1)).Value
ReDim y(1 To lastRow, 1 To 1)
For i = 1 To lastRow
For j = 1 To 10
If x(i, 1) Like "*" & Right(j, 1) & "*" Then
y(i, 1) = y(i, 1) & Right(j, 1)
End If
Next j
Next i
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(y, 1)
If Not .Exists(y(i, 1)) Then .Add y(i, 1), Empty
Next
Range("B1").Resize(.Count).Value = _
Application.Transpose(.Keys)
End With
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range("B1:B" & lastRow).Sort _
Key1:=Range("B1"), _
Order1:=xlAscending, _
Header:=xlNo, _
Orientation:=xlTopToBottom
End Sub
おっと、私が先に載せたseiyaさんの結果図の内 B8:B9は前のデータが残ってたみたいですね。 失礼しました。
後は ＞Sub VSortM(ary, LB, UB, ref, myOrd As Long) の前に「End Sub」が入れば Hatchさんが書かれている結果に成りますね。
(HANA)
あれ？修正時にEnd Sub 消してしまったようですね。 元通りにしておきました。 二次元配列を並び替えするときにでも使用してください。 QuickSortを基に書いてあります。 (seiya)
こんにちは〜♪
きょうは、お仕事も忙しくないので。。。 関数案も、Maronさんだけだし。。。
それに、最初はトンチンカンな回答してしまいましたので〜。。！！
名誉挽か〜いいい！！。。。 という事で。。。 Maronさんの考え方をチョット盗んで。。。
B1セルへ =REPT(0,ISNUMBER(FIND(0,A1)))&SUM(SMALL(IF(ISNUMBER(FIND(ROW($1:$10)-1,A1)), (ROW($1:$10)-1),0),ROW($1:$10))*10^(10-ROW($1:$10)))
配列数式です。。Ctrl＋Shift＋Enterキーで式を確定します。。
式が{ } で囲まれます。。
その式を下へコピー。。。
★データの中に、0(ゼロ)があるとやっぱり厄介ですね。。。 上の式は、0 がある場合、最初に 0 を持ってきてます。 その場合、文字列になります。。
★最後を 0 にする場合は こちらは、数値になります。。
=(SUM(SMALL(IF(ISNUMBER(FIND(ROW($1:$10)-1,A1)),(ROW($1:$10)-1),0), ROW($1:$10))*10^(10-ROW($1:$10)))&REPT(0,ISNUMBER(FIND(0,A1))))*1
同じく配列数式です。。
ご参考にどうぞ。。。
。。。Ms.Rin〜♪♪
ちなみに、 vba array のソートはFunctionだと使用メモリーが倍になってしまうので渡された配列が巨大な場合は 問題が発生すると思います。 Transpose関数も然りです。 (seiya)
だるまです。 http://hp.vector.co.jp/authors/VA033788/index.html
久しぶりにここを覗いて、私が頓珍漢な回答をしていることに気付きました。
「昇順降順」だけに反応して、A列のデータを重複カットしてB列に並べる、ものと思い込んでいましが、 最初の例を良く見ると、各セル内の値一つ一つに対してその中で重複カット＆昇順にして隣のB列に表示 が正しい質問内容だったようですね。(^^ゞ
すでに幾つもの回答がでていますので、もう私の出番はなさそうです。どうもお騒がせしました。^d^
◆こんどは、Ms.Rinさんの考え方をチョット盗んで A B 1 123456 123456 2 115235 1235 3 567583 35678 4 28 28 5 98776354 3456789 6 208 280 7 710017 170
B1=SUMPRODUCT((SMALL(INDEX(ISNUMBER(FIND(ROW($1:$10)-1,A1))*(ROW($1:$10)-1),), ROW($1:$10))*10^(10-(ROW($1:$10))))*10^(ISNUMBER(FIND(0,A1)))) ★Enterで式を確定後、下にコピー (Maron)
ふたたび〜です。。。♪
Maronさん、フムフム。。ソ〜カッ。そ〜か。 なるほど〜！！。。。
┌─┬──────┬─────┐ │ │ A │ B │ ├─┼──────┼─────┤ │ 1│ 123456│ 123456│ ├─┼──────┼─────┤ │ 2│ 115235│ 1235│ ├─┼──────┼─────┤ │ 3│ 567583│ 35678│ ├─┼──────┼─────┤ │ 4│ 28│ 28│ ├─┼──────┼─────┤ │ 5│ 98776354│ 3456789│ ├─┼──────┼─────┤ │ 6│ 208│ 280│ ├─┼──────┼─────┤ │ 7│ 710017│ 170│ └─┴──────┴─────┘
更に、Maronさんのアイデアをお借りして(2回目)。。。 チョッピリ、微調整。。。
B1セルへ =SUMPRODUCT(SMALL(INDEX(ISNUMBER(FIND(ROW($1:$10)-1,A1))*(ROW($1:$10)-1),),ROW ($1:$10))*10^(10+ISNUMBER(FIND(0,A1))-(ROW($1:$10))))
下へコピー。。。
。。。Ms.Rin〜♪♪
HANA さんのビンソート、スマートですね♪
ところで
10000
のときは、
01
が求める並びでしょうか？ それとも 1 でいいのかな？
(kanabun)
kanabunさんの仰っている事も気になるところですが・・・ お遊びで考えてみましたｗ =--(IF(LEN(SUBSTITUTE(A1,"1",))=LEN(A1),"","1")& IF(LEN(SUBSTITUTE(A1,"2",))=LEN(A1),"","2")& IF(LEN(SUBSTITUTE(A1,"3",))=LEN(A1),"","3")& IF(LEN(SUBSTITUTE(A1,"4",))=LEN(A1),"","4")& IF(LEN(SUBSTITUTE(A1,"5",))=LEN(A1),"","5")& IF(LEN(SUBSTITUTE(A1,"6",))=LEN(A1),"","6")& IF(LEN(SUBSTITUTE(A1,"7",))=LEN(A1),"","7")& IF(LEN(SUBSTITUTE(A1,"8",))=LEN(A1),"","8")& IF(LEN(SUBSTITUTE(A1,"9",))=LEN(A1),"","9")& IF(LEN(SUBSTITUTE(A1,"0",))=LEN(A1),"","0")) （キリキ）（〃⌒o⌒)b
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.