人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

2?4つの文字数バラバラの単語で構成される文字列を並べ替える方法につきまして
今、A列に次のような文字列が10000行近く、ずらりと並んでおります。

単語A★単語B★単語C■
単語D★単語E★単語F★単語G■
単語H★単語I■
単語J★単語K★単語L■
単語M★単語N■
単語O★単語P★単語Q★単語R■




1つのセルは2?4つの単語の文字列が入っております。
それぞれの単語自体はバラバラで特に規則性はないです。
単語と単語の間に★印があり、最後の単語の後ろには■がくっ付いております。
上記の状態から、

単語C■単語A★単語B★
単語G■単語D★単語E★単語F★
単語I■単語H★
単語L■単語J★単語K★
単語N■単語M★
単語R■単語O★単語P★単語Q★




と、並べ替えを行いたいのです。
量が多くて困っているのですが・・・何かよい並べ替えのマクロや関数等ありましたら、
お教えいただけないでしょうか。

よろしくお願い致します。

●質問者: moon-fondu
●カテゴリ:コンピュータ 学習・教育
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● a-kuma3
●1000ポイント ベストアンサー

マクロですが、こんな感じで。

Sub change_data()
 COL_POS = 1  ' A列
 ROW_START = 1
 ROW_END = 10000

 Set re = CreateObject("VBScript.RegExp")
 re.Pattern = "^(.*★)(.*■)$"
 For i = ROW_START To ROW_END
 Set c = Cells(i, COL_POS)
 If IsEmpty(c) Or c.Value = "" Then
 Exit For
 End If
 Set remat = re.Execute(c.Value)
 If remat.Count > 0 Then
 s1 = remat(0).SubMatches(0)
 s2 = remat(0).SubMatches(1)
 c.Value = s2 & s1
 End If
 DoEvents
 Next
End Sub

A列を ROW_START 行から、ROW_END の行まで処理します。
途中、空のセルがあれば、そこで処理を中止するようにしてます。




追記です。
式でもやってみました。

=RIGHT(A1,LEN(A1)-FIND("@@@",SUBSTITUTE(A1,"★","@@@",LEN(A1) - LEN(SUBSTITUTE(A1,"★","")))))&LEFT(A1,FIND("@@@",SUBSTITUTE(A1,"★","@@@",LEN(A1) - LEN(SUBSTITUTE(A1,"★","")))))

式の中に何度か出てくる "@@@" はどんな文字列でも良いんですが、セルの中に絶対に出てこない文字列です。
この式を、1行目のどこかの列に入力して、下方向に必要な数だけコピーしてください。


マクロの方が簡単です (´・ω・`)
もし、どうしても関数でやりたいとしたら、VBA でユーザ定義関数を書いて、それを使った方が簡単(メンテが楽)だと思います。




追記です。

空白セルはスキップして並べ替えることが出来るマクロの方をお教えいただきますでしょうか。

空白セルで処理を止めるところを削除しました。
指定した行数だけ処理します。

Sub change_data()
 COL_POS = 1  ' A列
 ROW_START = 1
 ROW_END = 10000

 Set re = CreateObject("VBScript.RegExp")
 re.Pattern = "^(.*★)(.*■)$"
 For i = ROW_START To ROW_END
 Set c = Cells(i, COL_POS)
 Set remat = re.Execute(c.Value)
 If remat.Count > 0 Then
 s1 = remat(0).SubMatches(0)
 s2 = remat(0).SubMatches(1)
 c.Value = s2 & s1
 End If
 DoEvents
 Next
End Sub

moon-fonduさんのコメント
関数うまくいきました!ありがとうございます。 すみません、マクロの方なのですが、空白セルもたまに出てきまして。 そのせいでしょうか、マクロの方はうまく稼働しないのです。 空白セルはスキップして並べ替えることが出来るマクロの方をお教えいただきますでしょうか。 たびたびすみません、よろしくお願い致します。

a-kuma3さんのコメント
>> 空白セルはスキップして並べ替えることが出来るマクロの方をお教えいただきますでしょうか。 << 回答に追記しました。 空白のセルが出てくるところまでは、きちんと処理できてますよね?

moon-fonduさんのコメント
すごいです、ありがとうございます。 空白セルありましたが、一瞬で変わりました!

2 ● rsc
●100ポイント

上の方より、単純でレベル低いですが、こちらはいかがでしょうか。
InStrRev関数を使ってみました。テストのため「ROW_END = 6」にしてありますので変えてみてください。

Option Explicit

Sub change_data()
 Dim n As Integer: n = 0
 Dim s As String: s = ""
 Dim i As Integer
 
 Dim COL_POS, ROW_START, ROW_END As Integer
 COL_POS = 1 ' A列
 ROW_START = 1
 ROW_END = 6
 
 For i = ROW_START To ROW_END
 s = Cells(i, COL_POS).Value
 If IsEmpty(Cells(i, COL_POS)) Or s = "" Then Exit For
 n = InStrRev(s, "★")
 If n = 0 Then Exit For
 Cells(i, COL_POS).Value = Mid(s, n + 1) & Left(s, n)
 DoEvents
 Next
End Sub

※参考URL
●Office TANAKA - Excel VBA関数[InStrRev関数]
http://officetanaka.net/excel/vba/function/InStrRev.htm


moon-fonduさんのコメント
ご回答いただきまして、ありがとうございます! マクロの方を実行してみたのですが、A列に空白セル等混じっていたからでしょうか、実行ボタンを押しても無反応でした・・・。

rscさんのコメント
こんな感じでMsgBoxでエラー行を調べてみるといいかも知れません。(^_^; >|vba| Option Explicit Sub change_data() Dim n As Integer: n = 0 Dim s As String: s = "" Dim i As Integer Dim COL_POS, ROW_START, ROW_END As Integer COL_POS = 1 ' A列 ROW_START = 1 ROW_END = 6 For i = ROW_START To ROW_END s = Cells(i, COL_POS).Value If IsEmpty(Cells(i, COL_POS)) Or s = "" Then MsgBox i Exit For End If n = InStrRev(s, "★") If n = 0 Then MsgBox i Exit For End If Cells(i, COL_POS).Value = Mid(s, n + 1) & Left(s, n) DoEvents Next End Sub ||<

moon-fonduさんのコメント
rscさんご回答ありがとうございます! 1行目がエラーであることが判りました! 見出しとして、普通の文字列を入れていましたね。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ