[[20080621110150]] 『独自の並べ替え』(ジョナサン) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『独自の並べ替え』(ジョナサン)
 エクセル初心者です。教えて下さい。
製品の番号の後に左右を示すR,Lと枝番があり、うまく並べ替えられません。
「ユーザー設定の並べ替え」の「ユーザー設定リスト」で出来るかと思いましたが文字数制限で出来ませんでした。。
希望としては
  1
 1R
 1L
 1A
 1AR
 1AL
 1-1
 1-1R
 1-1L
 1A-1R
 1A-1L
 2 
 2R
 2L
 : 
という順番に並べ替えをしたいのですが可能でしょうか?
1Rは1の右用、1Lは1の左用、1Aは1の枝分かれ製品、1ARはその右用の製品…という意味
で1ALの後に1B,1BR,1BL,1C,1CR,1CLと続く場合もあります。またそれが最終的に100を超える場合もあります。(100A-1Rなど)
Excel2007,WindowsXPです。どうぞ宜しくお願い致します。

 ユーザー設定リストで範囲を区切ってリストに登録するのはどうですか
 リストの登録できる範囲内で区切りのよいところで登録し、並べ替える範囲を選択して何回かに分けて並び替える
 こんな方法はできますか?
 (wisemac21)

wisemac21さん、ありがとうございます。
 リストの文字数は255文字までとなっていて、そんなに沢山は登録できなかったんです。
また、1で始まって5,5R,6,7,7A等、間を飛ばしたりもしますので、区切って小分けにし
てやるにも作業としては結構やりづらくなってしまうんです。
例えばもう少し条件を減らして *,*R,*L,*Aという順番に並べるということでしたらどうでしょう?
設定リストでワイルドカードが使えたらいいのですが。。(ジョナサン)


 そのまま並べ替えることを考えずにまず、作業列にそれぞれの要素に分解することを考えたらどう
 でしょうか。(とおりすがり)


 別シート(Sortと仮定)のA列に
  1
 1R
 1L
 1A
 1AR
 1AL
 1-1
 1-1R
 1-1L
 1A-1R
 1A-1L
 2 
 2R
 2L
 :
 と入力して
 並べ替えをするシートの空いた列に
 =Match(A1,Sort!A:A)
 として、並べ替えでは?
 (seiya)


 作業列を設けて
 B1=LEN(A1)
 C1=LEFT(A1,1)
 D1=IF(B1=1,"あ",MID(A1,2,4))
 式を下へコピー

 データ→並び替えで
 最優先されるキー C列で昇順
 2番目に優先されるキー B列で昇順
 3番目に優先されるキー D列で降順
 これでどうなりますか?
 (wisemac21) 

とおりすがりさん、seiyaさん、wisemac21さん、皆さんどうもありがとうございます。
seiyaさん、すみません。未熟なもので教えて頂いたようにうまくできませんでした。。
wisemac21さん、下記のように、希望にかなり近づきました。

 1
 1A-1R
 1A-1L
 2
 2R
 2L
 1R
 1L
 1A
 1AR
 1AL
 1-1
 1-1R
 1-1L

2が最初のほうにきてしまいますがそれを除けばほぼいい感じです。


 作業列をたくさん使います。
 >1ALの後に1B,1BR,1BL,1C,1CR,1CLと続く場合もあります。
 に関しては、ユーザー設定リストに登録して下さい。
 それでも255文字以上に成る場合は、作業列を
 もう少し増やす必要が有るのでしょうけど・・・。
 一つのアルファベットに付き、3パターンだから大丈夫かな・・・?

 ↓B列以降が作業列です。
	[A]	[B]	[C]	[D]	[E]	[F]	[G]	[H]	[I]
[1]	1	0	1		1	1	0	0	0
[2]	1R	0	1R		1	1	R	0	0
[3]	1L	0	1L		1	1	L	0	0
[4]	1A	0	1A		1	1	A	0	0
[5]	1AR	0	1AR		1	1	AR	0	0
[6]	1AL	0	1AL		1	1	AL	0	0
[7]	1B	0	1B		1	1	B	0	0
[8]	1BR	0	1BR		1	1	BR	0	0
[9]	1BL	0	1BL		1	1	BL	0	0
[10]	1-1	1	1	1	1	1.1	0	1	0
[11]	1-1R	1	1	1R	1	1.1	0	1	R
[12]	1-1L	1	1	1L	1	1.1	0	1	L
[13]	1A-1R	1	1A	1R	1	1.1	A	1	R
[14]	1A-1L	1	1A	1L	1	1.1	A	1	L
[15]	2	0	2		2	2	0	0	0
[16]	2R	0	2R		2	2	R	0	0
[17]	2L	0	2L		2	2	L	0	0
[18]	2-1	1	2	1	2	2.1	0	1	0
[19]	2-2	1	2	2	2	2.1	0	2	0
[20]	100A-1R	1	100A	1R	100	100.1	A	1	R
 B1
=COUNTIF(A1,"*-*")
 C1
=IF(B1,LEFT(A1,FIND("-",A1)-1),A1)
 D1
=SUBSTITUTE(SUBSTITUTE(A1,C1,,1),"-",)
 E1
=LOOKUP(10^9,LEFT(C1,ROW($1:$30))*1)
 F1
=E1+B1/10
 G1
=IF(SUBSTITUTE(C1,E1,)="",0,SUBSTITUTE(C1,E1,))
 H1
=IF(D1="",0,LOOKUP(10^9,LEFT(D1,ROW($1:$30))*1))
 I1
=IF(SUBSTITUTE(D1,H1,)="",0,SUBSTITUTE(D1,H1,))

 ユーザー定義リストには
0
R
L
A
AR
AL
B
BR
BL
 の様に定義して下さい。

 F列以降を左の列が上位になるように並べ替えます。

 1.メニュー・データ(D)→並べ替え
   I列を最優先されるキーに指定して、
   ユーザー定義の順に並べ替え
 2.H1セルを選択し、 A→Z ボタンを押す
 3.G1セルを選択し、 A→Z ボタンを押す
 4.F1セルを選択し、 A→Z ボタンを押す

 です。

 (HANA)

 C列を最優先キーにしているので2が最初の方にくることはないはずですが・・・
 1
 1A-1R
 1A-1L
 2
 2R
 2L
 1R
 1L
 1A
 1AR
 1AL
 1-1
 1-1R
 1-1L
 で 同じように作業列を設けて並び替えると
 1
 1R
 1L
 1A
 1AR
 1AL
 1-1
 1-1R
 1-1L
 1A-1R
 1A-1L
 2
 2R
 2L
 このように並び替えできます。
 何がおかしいのですかね?
 (wisemac21)


HANAさん、どうもありがとうございます。
何度かやってみましたがどうしても下記のようになってしまいました。

 1	0	1		1	1	0	0	0
1A	0	1A		1	1	A	0	0
1AL	0	1AL		1	1	AL	0	0
1AR	0	1AR		1	1	AR	0	0
1B	0	1B		1	1	B	0	0
1BL	0	1BL		1	1	BL	0	0
1BR	0	1BR		1	1	BR	0	0
1L	0	1L		1	1	L	0	0
1R	0	1R		1	1	R	0	0
1-1	1	1	1	1	1.1	0	1	0
1-1R	1	1	1R	1	1.1	0	1	R
1-1L	1	1	1L	1	1.1	0	1	L
1A-1R	1	1A	1R	1	1.1	A	1	R
1A-1L	1	1A	1L	1	1.1	A	1	L
2	0	2		2	2	0	0	0
2L	0	2L		2	2	L	0	0
2R	0	2R		2	2	R	0	0
2-1	1	2	1	2	2.1	0	1	0
2-2	1	2	2	2	2.1	0	2	0
100A-1R	1	100A	1R	100	100.1	A	1	R
 

RとLが逆になってしまうのですが、ユーザー定義リストが効いていないのでしょうか?(ジョナサン)


wisemac21さんごめんなさい、確かに並びました。
 不慣れな為、どこがおかしかったのか分かりませんが、何かの単純ミスかもしれません。
 ただ、10L等の場合には1-1の上にきてしまいました。桁数が増えた場合はどのように
 したらよいでしょう。。(ジョナサン)


 >RとLが逆になってしまうのですが、
 と言う事ですが
 「1A-1R」「1A-1L」は、この並びで良いのですよね?
 つまり、I列を並べ替える時は 正しく並び変わっている様です。

 並べ替えは、一列ずつ行っていただけましたか?
 メニュー・並べ替え で3つ選択して並べ替えた場合
 「最優先されるキー」で指定された物しか
 指定した順序で並ばないようです。
(何か方法が有るのかもしれませんが、私のエクセルでは少なくとも。)

 最優先されるキーにG列を指定し
 オプションで並べ替え順序が
「0,R,L,A,AR,AL,B,BR,BL」
 に成っていることを確認し、
 この列だけで並べ替えてみてもらえませんか?

 (HANA)

HANAさん、遅くまでありがとうございます。
 >並べ替えは、一列ずつ行っていただけましたか?
 はい、ご指示頂いた順で行いました。(まとめてやった場合とやはり結果が違いました)

 G列を最優先にユーザー定義順に並び変えた上で次にI列を優先し、ユーザー定義順に→H列を昇順→F列を昇順。の順で行ったところ、出来ました!・・が、
 これでよろしかったでしょうか?

 1	0	1		1	1	0	0	0
 1R	0	1R		1	1	R	0	0
 1L	0	1L		1	1	L	0	0
 1A	0	1A		1	1	A	0	0
 1AR	0	1AR		1	1	AR	0	0
 1AL	0	1AL		1	1	AL	0	0
 1B	0	1B		1	1	B	0	0
 1BR	0	1BR		1	1	BR	0	0
 1BL	0	1BL		1	1	BL	0	0
 1-1	1	1	1	1	1.1	0	1	0
 1-1R	1	1	1R	1	1.1	0	1	R
 1A-1R	1	1A	1R	1	1.1	A	1	R
 1-1L	1	1	1L	1	1.1	0	1	L
 1A-1L	1	1A	1L	1	1.1	A	1	L
 2	0	2		2	2	0	0	0
 2R	0	2R		2	2	R	0	0
 2L	0	2L		2	2	L	0	0
 2-1	1	2	1	2	2.1	0	1	0
 2-2	1	2	2	2	2.1	0	2	0
 100A-1R	1	100A	1R	100	100.1	A	1	R

 ややこしい並び替えにイライラしてきましたがこれで作業が大変楽になります。お力添えを本当にありがとうございます。(ジョナサン)


 いいえ、G列だけでやってもらったのは
  I列は並び替えが出来るが、G列は出来ない
 なんて可能性が無いことを確認したいためにやってもらっただけで
 実際にやる場合は、I列からF列方向へ
 【一列ずつ指定しながら】並べ替えを行ってください。

 今回はたまたまサンプルデータが良かった(悪かった?)ので
 ご希望通りに成ったのかもしれませんが、
 ↓のデータでは  ↓の順に成りますよね?
 1A-2R		1A-2R
 1A-2L		1B-2R
 1B-2R		1A-2L
 1B-2L		1B-2L

 並べ替えは、左側が上位に来るように
 (最終的に左側に多い物が並ぶように
   ・・・・直上のサンプルでは
   一番最後が「R」で終わるもの・「L」で終わる物
   と言うまとまりではなく
   二番目が「A」のもの「B」のもの
   と言うまとまりに成るように・・・
  です。)
 成る必要が有ると思うので、やはり
 右側から順に並べ替えを行う必要が有ります。

 メニュー・データ(D)→並べ替え で並べ替えを行う場合は
 「最優先されるキー」に一列ずつ指定しながら4回並べ替えを行うか
 一度に複数列で並べ替えをしても、「最優先されるキー」に指定した列は
 指定した順に並び変わるので
  1.最優先されるキー 列I
  2.最優先されるキー 列G
    2番目に優先・・・ 列H
  3.最優先されるキー 列F
 とすれば、3回で済みます。

 もしも何度もやる必要が有るのなら、この並べ替えの部分は
 マクロの記録にしておくと良いかもしれません。

 手順は、通常の並べ替えをするときと同じですが
 範囲がその都度変わると思いますので、記録を開始した後に
 「A:I列を選択」する操作を行った後
 並べ替えを行います。

 2007でのマクロの記録方法が私は分かりませんので
 「毎回面倒な並べ替えをしたくない」と思われるなら
 Web検索をしてみて下さい。

 (HANA)


HANAさん、ありがとうございます。
 なるほど、たまたまだったんですね。少し分かってきました。少々確認したいのですが・・

 1.メニュー・データ(D)→並べ替え
   I列を最優先されるキーに指定して、
   ユーザー定義の順に並べ替え
 2.H1セルを選択し、 A→Z ボタンを押す  
 3.G1セルを選択し、 A→Z ボタンを押す
 4.F1セルを選択し、 A→Z ボタンを押す

2〜4は昇順でやっていましたが

 1.最優先されるキー 列I →ユーザー定義の順
 2.最優先されるキー 列G →ユーザー定義の順
   2番目に優先・・・ 列H →昇順
 3.最優先されるキー 列F →昇順

とするか、または最初の手順で行うなら

 1.メニュー・データ(D)→並べ替え

   I列を最優先されるキーに指定して、
   ユーザー定義の順に並べ替え
 2.H1セルを選択し、 A→Z ボタンを押す →昇順 
 3.G1セルを選択し、 A→Z ボタンを押す →ユーザー定義の順
 4.F1セルを選択し、 A→Z ボタンを押す →昇順

 ということでしょうか?こんがらがってきました。。
 この並べ替えは今後何度も行いますので教えて頂いたマクロの記録という方法も試してみたいと
 思います。(ジョナサン)

 2007になって、並べ替えの部分も少し変わっている見たいですね・・・。
 私は持っていないので、確認がとれないのですが

 今回の作業セルは
  F列 ハイフンより前の数値部分に、ハイフンの有無をプラスした物
  G列 ハイフンより前のアルファベット部分
  H列 ハイフンより後の数値部分
  I列 ハイフンより後のアルファベット部分
 の様に分けてあります。

 ですから、厳密な事を言うと
 F,H列は 昇順
 G,I列は ユーザー定義の順
 で並べ替えになりますが、今回は ユーザー定義の順に
 数値の並ぶ順番を変える物は入っていません。
 ですから、F,H列を並べ替えるときに
 標準だろうと、ユーザー定義の順だろうと
 どちらでも良いことになります。

 が、せっかく「ユーザー定義の順」ボタンが有るのですから
 これと「A→Z」ボタンを使えば良いと思います。

 現在私が使用している2002では、「ユーザー定義の順」
 と言うボタンは無くて、並べ替えのオプションから
 設定する様になっているので・・・
 そのまま話をしていたので、混乱させてしまったのかもしれません。
 ごめんなさいね。

 >マクロの記録という方法も試してみたいと思います。
 と言う事ですので、↓捜してみました。
http://www.eurus.dti.ne.jp/~yoneyama/Excel2007/FAQ/kaihatu.html
 よねさんのWordとExcelの小部屋
http://hamay.blogspot.com/2007/04/blog-post_3949.html
 Vista & 2007 Office system はまちゃんらんどPart2

 記録ボタンさえ出してしまえば後は通常の操作と同じだと思うので・・・・。
http://www.excel.studio-kazu.jp/lib/e4b/e4b.html

 ●マクロの記録を開始して
 1.A:I列を選択
 2.メニュー・データ(D)→並べ替え
   I列を最優先されるキーに指定して、
   ユーザー定義の順に並べ替え
 3.H1セルを選択し、 A→Z ボタンを押す  
 4.G1セルを選択し、 A→Z ボタンを押す
 5.F1セルを選択し、 A→Z ボタンを押す
 ■記録終了

 です。

 ただし、保存方法や、設置場所等はまた
 2007で変わっている様ですので
 リンク先をご参考になさって下さい。

 ・・・でも、ボタンを4回押すだけだから
 マクロにする程の物でもないかも・・・。
(最初に どのユーザー定義にするか選ぶ手間は
 省けると思いますけど・・・。)

 (HANA)

HANAさん、どうもありがとうございます。
 昨年購入したPCなので自動的に2007版だったんです。

 >ですから、F,H列を並べ替えるときに
 標準だろうと、ユーザー定義の順だろうと
 どちらでも良いことになります。

 確かにどちらも同じ結果でした。数式の意味が分かればくどくどお聞きするまでもないのでしょうね。お手数お掛けしました。
 とても丁寧に解説して下さってどうもありがとうございました。
 ご紹介頂いたリンク先にもお邪魔して勉強してみます。長い時間お付き合い頂き恐縮です。
 でもとても助かりました。重ねがさね御礼申し上げます。(ジョナサン)


 たぶん、大丈夫でしょうけど念のため・・・。

 > F列 ハイフンより前の数値部分に、ハイフンの有無をプラスした物
 > G列 ハイフンより前のアルファベット部分
 > H列 ハイフンより後の数値部分
 > I列 ハイフンより後のアルファベット部分

 と書きましたが、これは A列のデータが
 (数値)(アルファベット)(−)(数値)(アルファベット)
 の順で並んでいる場合です。

 例えば、(数値)(アルファベット)(数値)(−)・・・
 の様な物が有ると、意図した結果には成りませんので
 ご注意下さい。

 (HANA)

HANAさん、ありがとうございます。
 >例えば、(数値)(アルファベット)(数値)(−)・・・
 の様な物が有ると、

1A1-1というパターンは無いので大丈夫です。お気遣いありがとうございます。

 マクロの記録のほうも無事できました。並べ替え用のシートを作ったので
今後とても楽になります。ありがとうございました。(ジョナサン)

 あぁぁ・・・2007って確認したはずなのに
 上の記録手順は違っていますね。
 ごめんなさい。

 >マクロの記録のほうも無事できました。
 と言うことなら、書いてあることは多めに見て下さったのですね。
 ごめんなさいね。

 でも、うまく行ったようで良かったです。
 結果オーライと言うことで。(笑)

 (HANA)

 面白そうなんで寄せてくらはい。^^
 決着済みに今更・・・とは言うて下さるな。
 Sheet1のデータをSheet2に拾い出します。
 何か抜けとるような気ぃがしてならんのんですが、上手いこといきゃ儲けモン、という
 程度のマクロなんでんせ、えぇ。
       (弥太郎)
 '-----------------------
 Sub 並べ替え()
    Dim Rex As Object, i As Long, tbl, x
    Set Rex = CreateObject("vbscript.regexp")
    With Sheets("sheet1")
        tbl = .Range("a1").Resize(.Range("a" & Rows.Count).End(xlUp).Row)
    End With
    With Sheets("sheet2")
        For i = 1 To UBound(tbl, 1)
            Rex.Pattern = "^(\d+)([A-Z]\-.+|\-\d+(R|L))"
            If Rex.test(tbl(i, 1)) Then
                If Right(tbl(i, 1), 1) = "R" Then
                    tbl(i, 1) = IIf(Left(Rex.Replace(tbl(i, 1), "$2"), 1) = "-", Rex.Replace(tbl(i, 1), "$1") _
                            & "い" & Rex.Replace(tbl(i, 1), "$2"), Rex.Replace(tbl(i, 1), "$1") _
                                & "う" & Rex.Replace(tbl(i, 1), "$2"))
                ElseIf Right(tbl(i, 1), 1) = "L" Then
                    tbl(i, 1) = IIf(Left(Rex.Replace(tbl(i, 1), "$2"), 1) = "-", Rex.Replace(tbl(i, 1), "$1") _
                            & "え" & Rex.Replace(tbl(i, 1), "$2"), Rex.Replace(tbl(i, 1), "$1") _
                                & "お" & Rex.Replace(tbl(i, 1), "$2"))
                End If
            Else
                Rex.Pattern = "^\d+\-\d+$"
                If Rex.test(tbl(i, 1)) Then
                    tbl(i, 1) = Replace(tbl(i, 1), "-", "あ-")
                End If
            End If
            If IsNumeric(tbl(i, 1)) Then tbl(i, 1) = tbl(i, 1) & "!"
            tbl(i, 1) = Replace(Replace(Replace(tbl(i, 1), "R", "#"), "L", "$"), "-", "z?")
        Next i
        Application.ScreenUpdating = False 'ここ追加
        .Range("a1").Resize(UBound(tbl, 1)) = tbl
        .Range("a1").Resize(UBound(tbl, 1)).Sort _
         key1:=.Range("a1"), order1:=xlAscending, MatchCase:=True
        tbl = .Range("a1").Resize(UBound(tbl, 1))
        For i = 1 To UBound(tbl, 1)
            tbl(i, 1) = Replace(Replace(Replace(Replace(Replace(Replace( _
                            Replace(Replace(Replace(tbl(i, 1), "!", ""), "#", "R"), "$", "L"), _
                                "z?", "-"), "お", ""), "い", ""), "え", ""), "う", ""), "あ", "")
        Next i
        .Range("a:a").NumberFormatLocal = "@"
        .Range("a1").Resize(UBound(tbl, 1)) = tbl
            Rex.Pattern = "[A-Z-]"
            ReDim x(1 To UBound(tbl, 1), 1 To 2)
            For i = 1 To UBound(tbl, 1)
                If Rex.test(tbl(i, 1)) Then
                x(i, 1) = Left(tbl(i, 1), Rex.Execute(tbl(i, 1))(0).firstindex)
                x(i, 2) = Right(tbl(i, 1), Len(tbl(i, 1)) - Len(x(i, 1)))
                Else
                    x(i, 1) = tbl(i, 1)
                End If
            Next i
        .Range("a:a").NumberFormatLocal = "G/標準"
        .Range("a1").Resize(UBound(tbl, 1), 2) = x
        .Range("a1").Resize(UBound(tbl, 1), 2).Sort key1:=.Range("a1"), order1:=xlAscending
        tbl = .Range("a1").Resize(UBound(tbl, 1), 2)
        ReDim x(1 To UBound(tbl, 1), 1 To 1)
        For i = 1 To UBound(tbl, 1)
            x(i, 1) = tbl(i, 1) & tbl(i, 2)
            If IsDate(x(i, 1)) Then x(i, 1) = "'" & x(i, 1)
        Next i
        .Range("a1").Resize(UBound(x, 1)) = x
        .Range("b:b").ClearContents
    End With
    Application.ScreenUpdating = True 'ここも追加
 End Sub

 通りすがり〜
 やはり締めは(弥太郎)様
 この学校の特徴は、色々と指導しながら行う方
 (弥太郎)様みたいに掲示して下さる方がいますが
 皆さんは(弥太郎)さんを希望される方を待っていると思います。
 しかし(弥太郎)様は毎回、素晴らしい且つ正確で尊敬いたします。(通りすがり)

 ↑これは褒め殺しでっか?^^

 画面のちらつきを無くす為2行追加しますた。
      (弥太郎)


HANAさん、ありがとうございます。
 確かにちょっと戸惑う部分もありましたが問題無いです。大丈夫でした。
 出来た時は部屋でひとりガッツポーズでした。(自分の力じゃないのに)(ジョナサン)

弥太郎さん、通りすがりさん、ありがとうございます。
 皆さんに助けて頂いて感謝・感謝です。
教えて頂いたマクロを試してみましたら出来ました。Sheet2にちゃんと転記してくれました。
 色々なやり方があるんですね。素晴らしいです。。ところでちょっと質問したいのですがよろしいでしょうか・・
A列に数量、C列に大分類記号、B列に並べ変えたい英数字がある場合、A,C列も同時に並び変わった
順で転記して欲しいのですが、マクロは大きく変わるのでしょうか。(ジョナサン)

  > マクロは大きく変わるのでしょうか
 いんや、変更する個所はそう大してないんですけど・・・。
 口頭で説明するんは難しいでんなぁ。^^

 でも、やってみまひょか。
 1-先ず編集置き換えでtbl(i,1)をtbl(i,2)に全て置き換えます。
 2-一番最初のtblの引数に row) とあるのを row,3)に変更
 3-.Range("a:a").NumberFormatLocal = "@" '←をb列に変更
 4-.Range("a:a").NumberFormatLocal = "G/標準"  '←をD列に変更
 5-その行↑までのResize(Ubound(tbl,1))をResize(Ubound(tbl,1),3)に変更
 6-初めのソートのKeyをB1に変更
 7-.Range("a1").Resize(UBound(tbl, 1), 2) = x をD1に変更(2個所有り)
 8-そのソート作業を
 .Range("a1").Resize(UBound(tbl, 1), 5).Sort key1:=.Range("d1"), order1:=xlAscending  に変更   

    ここで一服〜^^

 9-xの1 to 1を1 to 3に変更
 10-そこから下は説明しにくいんでサービスしときます。
         For i = 1 To UBound(tbl, 1)
            x(i, 1) = tbl(i, 1)  '←
            x(i, 2) = tbl(i, 4) & tbl(i, 5)  '←
            x(i, 3) = tbl(i, 3)            '←
            If IsDate(x(i, 2)) Then x(i, 2) = "'" & x(i, 2)  '←
        Next i
        .Range("a1").Resize(UBound(x, 1), 3) = x  '←
        .Range("d:e").ClearContents          '←
 に変更

 いぜうのを漏れなく書き換えたら万事上手くいくと思いますが、さぁて、一発正解で
 派手なガッツポーズが出るか(机の角に拳をぶつけないよう^^)泥沼にはまりこむか
 見物でんなぁ。
              (弥太郎)


弥太郎さん、ありがとうございます。

やはり止まってしまいました。

 3-.Range("a:a").NumberFormatLocal = "@" '←をb列に変更

 というのは
 .Range("a:a").NumberFormatLocal = "B" ' とすればいいのかと思いましたが違うんですね?きっと (ジョナサン)

 はい、ちゃいます。
 .range("a:a")はA列なんです。
 これでお分かりでっしゃろ?
        (弥太郎)

弥太郎さん、ありがとうございます。
 今度は
 x(i, 2) = tbl(i, 4) & tbl(i, 5)  '←
のところでインデックスが有効範囲にないと表示されました。
泥沼にはまったようです・・。(ジョナサン)

 どうやら途中で一服したんが悪かったみたいでんなぁ。
 2回目のソートの一行下がUbound(tbl,1),2)になってまっしゃろ?
 2を5に変更してくらはい。(汗
          (弥太郎)


弥太郎さん、ありがとうございます。
 tbl = .Range("a1").Resize(UBound(tbl, 1), 5)
でよいのでしょうか?全く未知の世界なので2回目のソートの場所がわかりません。。
 一応止まらずに流れましたがSheet2にはC列とF列に#N/Aと表示されています。(ジョナサン)

 しょうおまへんなぁ・・・。
 どっかがどないかなってまんのやろ。^^
 それがしの指示違いかあんさんの変更マチガイか。
       (弥太郎)
 '----------------
 Sub 並べ替え2()
    Dim Rex As Object, i As Long, tbl, x
    Set Rex = CreateObject("vbscript.regexp")
    With Sheets("sheet1")
        tbl = .Range("a1").Resize(.Range("a" & Rows.Count).End(xlUp).Row, 3) '←
    End With
    With Sheets("sheet2")
        For i = 1 To UBound(tbl, 1)
            Rex.Pattern = "^(\d+)([A-Z]\-.+|\-\d+(R|L))"
            If Rex.test(tbl(i, 2)) Then
                If Right(tbl(i, 2), 1) = "R" Then
                    tbl(i, 2) = IIf(Left(Rex.Replace(tbl(i, 2), "$2"), 1) = "-", Rex.Replace(tbl(i, 2), "$1") _
                            & "い" & Rex.Replace(tbl(i, 2), "$2"), Rex.Replace(tbl(i, 2), "$1") _
                                & "う" & Rex.Replace(tbl(i, 2), "$2"))
                ElseIf Right(tbl(i, 2), 1) = "L" Then
                    tbl(i, 2) = IIf(Left(Rex.Replace(tbl(i, 2), "$2"), 1) = "-", Rex.Replace(tbl(i, 2), "$1") _
                            & "え" & Rex.Replace(tbl(i, 2), "$2"), Rex.Replace(tbl(i, 2), "$1") _
                                & "お" & Rex.Replace(tbl(i, 2), "$2"))
                End If
            Else
                Rex.Pattern = "^\d+\-\d+$"
                If Rex.test(tbl(i, 2)) Then
                    tbl(i, 2) = Replace(tbl(i, 2), "-", "あ-")
                End If
            End If
            If IsNumeric(tbl(i, 2)) Then tbl(i, 2) = tbl(i, 2) & "!"
            tbl(i, 2) = Replace(Replace(Replace(tbl(i, 2), "R", "#"), "L", "$"), "-", "z?")
        Next i
        Application.ScreenUpdating = False
        .Range("a1").Resize(UBound(tbl, 1), 3) = tbl
        .Range("a1").Resize(UBound(tbl, 1), 3).Sort _
         key1:=.Range("b1"), order1:=xlAscending, MatchCase:=True
        tbl = .Range("a1").Resize(UBound(tbl, 1), 3)
        For i = 1 To UBound(tbl, 1)
            tbl(i, 2) = Replace(Replace(Replace(Replace(Replace(Replace( _
                            Replace(Replace(Replace(tbl(i, 2), "!", ""), "#", "R"), "$", "L"), _
                                "z?", "-"), "お", ""), "い", ""), "え", ""), "う", ""), "あ", "")
        Next i
        .Range("b:b").NumberFormatLocal = "@"
        .Range("a1").Resize(UBound(tbl, 1), 3) = tbl
            Rex.Pattern = "[A-Z-]"
            ReDim x(1 To UBound(tbl, 1), 1 To 2)
            For i = 1 To UBound(tbl, 1)
                If Rex.test(tbl(i, 2)) Then
                x(i, 1) = Left(tbl(i, 2), Rex.Execute(tbl(i, 2))(0).firstindex)
                x(i, 2) = Right(tbl(i, 2), Len(tbl(i, 2)) - Len(x(i, 1)))
                Else
                    x(i, 1) = tbl(i, 2)
                End If
            Next i
        .Range("d:d").NumberFormatLocal = "G/標準"
        .Range("d1").Resize(UBound(tbl, 1), 2) = x
        .Range("a1").Resize(UBound(tbl, 1), 5).Sort key1:=.Range("d1"), order1:=xlAscending
        tbl = .Range("a1").Resize(UBound(tbl, 1), 5)
        ReDim x(1 To UBound(tbl, 1), 1 To 3)
        For i = 1 To UBound(tbl, 1)
            x(i, 1) = tbl(i, 1)
            x(i, 2) = tbl(i, 4) & tbl(i, 5)
            x(i, 3) = tbl(i, 3)
            If IsDate(x(i, 2)) Then x(i, 2) = "'" & x(i, 2)
        Next i
        .Range("a1").Resize(UBound(x, 1), 3) = x
        .Range("d:e").ClearContents
    End With
    Application.ScreenUpdating = True
 End Sub


弥太郎さん、最後までありがとうございます。

 おそらく私の方と思います。。汗だくでしたから。
 手取り足取りご面倒をお掛けしてすみません。
 今後、少しはおっしゃる意味が分かるようになりたいと思います。
 お手数お掛けしました。(ジョナサン)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.