ひとつのセル内で文字の位置を換える方法

質問

お世話様です。
EXCEL2003で、マクロをつかって下記の様に複数のパターンを一括で×の位置を揃えたいのですが可能でしょうか?

○ 150×100×200 → ○ 150× 100× 200
□□ 50×30 → □□ 50× 30
△△△ 1000×1000×2000 → △△△ 1000× 1000× 2000

ど素人で申し訳御座いませんが、ご指導願います。

回答No.5

okormazd

ここまで付き合ってもらえてよかったですね。普通ならもうあきれ返られてそのままか、いい加減にしろと怒られてそのままになるんですよね。
まだまだ、あいまいなところがあって、あなたに聞いてもあいまいさを解決するのは面倒なので、こちらでこうですよときめて処理をかきます。

以下は、これまでのあなたとのやり取りの範囲内で判明したことと、必要なことです。

１.このブックで使用するフォントはプロポーショナルではなく固定ピッチのフォントにしてください。そうしないとたての位置がずれてきちんとは揃えられません。
プロポーショナル　　　ＭＳＰ明朝、ＭＳＰゴシックなど。Ｐがついているもの。Ｐがなくてもプロポーショナルなものもある。
固定ピッチ　　　　　　ＭＳ明朝、ＭＳゴシックなど。Ｐがついていないもの。Ｐがなくても固定ピッチなものもある。

２.データは必ず下記のように２行１セットになっている。
Ｗ□Ｄ□Ｈ
●●□▲▲▲×▲▲▲×▲▲▲

３.▲の桁数は、最大４桁で、４桁未満のときはその前にロか×がくる。

４.データの範囲に空白行はない。

５.●●●●●●●●●●●●●●●の行は１行だけ独立していることはない。（２行１セットということ）

６.データセットの１行目は、ＷＤＨいずれもないか、ＷＤＨ，ＷＨ，Ｗのどれかがあり、この順序である。Ｈ，Ｄ，ＷＤ，ＨＤなどはない。

この条件ではなくても、はっきりわかればちゃんとプログラムできるが、今回はもうこれ以上やる気はありませんが、行きがかり上１回だけ質問を受けます。

以上の条件で下記のコード、自分の条件に合わせて適当に変更してください。

Sub test()

r = 5　　'データ行先頭
c = 4　　'データ列

ustr = Cells(r, c)
lu = Len(ustr)
Do While lu <> 0

nw = InStr(1, ustr, "Ｗ")
nd = InStr(1, ustr, "Ｄ")
nh = InStr(1, ustr, "Ｈ")

If nw <> 0 And nd = 0 And nh = 0 Then
ustr = String(17, "　") & "Ｗ　　"
Cells(r, c) = ustr
ElseIf nw <> 0 And nd = 0 And nh <> 0 Then
ustr = String(11, "　") & "Ｗ" & String(5, "　") & "Ｈ　　"
Cells(r, c) = ustr
ElseIf nw <> 0 And nd <> 0 And nh <> 0 Then
ustr = String(5, "　") & "Ｗ" & String(5, "　") & "Ｄ" & String(5, "　") & "Ｈ　　"
Cells(r, c) = ustr
ElseIf nw = 0 And nd = 0 And nh = 0 Then

End If

dstr = Cells(r + 1, c)
ld = Len(dstr)

n = 1
n1 = InStr(n, dstr, "×")
n2 = InStr(n1 + 1, dstr, "×")

If n1 = 0 And n2 = 0 Then
dstr = Left(dstr, ld - 4) & String(20 - ld, "　") & Right(dstr, 4)
ElseIf n1 <> 0 And n2 = 0 Then
nr = ld - n1
strl = Left(dstr, n1 - 1 - 4)
ll = Len(strl)
strr = "×" & String(5 - nr, "　") & Right(dstr, nr)
lr = Len(strr)
strm = String(20 - ll - lr - 4, "　") & Mid(dstr, n1 - 4, 4)
dstr = strl & strm & strr
ElseIf n1 <> 0 And n2 <> 0 Then
strl = Left(dstr, n1 - 1 - 4) & String(8 - (n1 - 1), "　") & Mid(dstr, n1 - 4, 4)
strm = "×" & String(5 - (n2 - n1 - 1), "　") & Mid(dstr, n1 + 1, n2 - n1 - 1)
nr = ld - n2
strr = "×" & String(5 - nr, "　") & Right(dstr, nr)
dstr = strl & strm & strr
End If

Cells(r + 1, c) = dstr

r = r + 2
ustr = Cells(r, c)
lu = Len(ustr)

Loop

End Sub

お礼

大変ご親切対応して頂き、本当に有難う御座いました。
とても参考になりました。
これからはこのサイトを頼らなく済む様に
がんばって勉強します。
御忙しい所、本当に有難う御座いました。

回答No.4

okormazd

ANo.1
です。

揃えるというイメージはいくらかわかってきましたが、
申し訳ありませんが、まだ理解できないところがあります。
「
Ｗ□Ｄ□Ｈ
●●□▲▲▲×▲▲▲×▲▲▲
」
のようなデータが、２段(上下２つのセル)にあるのですか。
それとも、１つのセルで２段になっているのですか。
あるいは、
データはどちらか(上か下か)1つなのですか。

補足

早速の御回答有難う御座います。
「
Ｗ□Ｄ□Ｈ
」
で全角２０文字が入る一つのセルです。
２段（上下二つのセル）です。
これ以外にも
「
●●●●●●●●●●●●●●●
」
と文字のみのセルが存在し、このようなセルは、
特に編集する必要はないので、
「
Ｗ□Ｄ□Ｈ
●●□▲▲▲×▲▲▲×▲▲▲
」
という様なパターンを検索して、
「
□□□□□Ｗ□□□□□Ｄ□□□□□Ｈ□□
●●□□□▲▲▲×□□▲▲▲×□□▲▲▲
」
の様に上段のW・D・Hを下段の数字(▲の百の位の位置)に
くる様にスペースを入れたいと思っております。
はじめより、条件が増えまして、申し訳御座いませんが、
マクロを組む事が可能であれば、教えて下さい。
宜しくお願い致します。

回答No.3

okormazd

ANo.1
ですが、
やりたいことはVBAでできると思いますが、
まだ、どういうものをどのようにしたいのか意図が伝わりません。

「
○＿＿＿＿１５０×＿１００×＿２００
□□＿＿＿＿＿＿＿＿＿５０×＿＿３０
△△△＿１０００×１０００×２０００
」
は、はじめのデータですか。
だとしたら、
これをどうしたいのですか。

「×の位置を揃えたい」といいますが、どういう風に揃えたいのですか。空白を削除したいのですか。

補足

御回答有難う御座います。
質問内容がおかしくて、申し訳御座いませんでした。
改めて、質問させて頂きます。

元のデーターは、左詰めで下記の様にあるとします。
(スペースを□、文字を●、数字を▲とします。※実際はスペースに□となっていません)

「
Ｗ□Ｄ□Ｈ
●●□▲▲▲×▲▲▲×▲▲▲
」
この状態から下記の様に編集したいのですが
「
□□□□□Ｗ□□□□□Ｄ□□□□□Ｈ□□
●●□□□▲▲▲×□□▲▲▲×□□▲▲▲
」
上記の様に文字(●)は全角１～４文字までで、ＷとＤとＨは
百の位のちょうど上にくる様にしたいのです。
一つのセルは全角２０文字です。

この他のパターンとしては、

「
Ｗ□Ｈ
●●●●□▲▲▲▲×▲▲▲▲
」
だとすると
「
□□□□□□□□□□□Ｗ□□□□□Ｈ□□
●●●●□□□□□□▲▲▲▲×□▲▲▲▲
」

「
Ｗ
●●●□▲▲▲▲
」
だとすると
「
□□□□□□□□□□□□□□□□□Ｗ□□
●●●□□□□□□□□□□□□□▲▲▲▲
」

という具合に複数のパターンを一度に揃えるマクロの組み方を教えて下さい。

度々で真に申し訳御座いませんが、何卒宜しく御願い致します。

回答No.2

toshi_yuki

ANo.1の方の方法ならば
Cells(1, 1).Value = Replace(Cells(1, 1).Value, "×", "× ")

後は(1,1)の部分を適当にループするなりすればよいのでは。

回答No.1

okormazd

どうしたいのか、意図が伝わりません。
>○ 150×100×200 → ○ 150× 100× 200
×のつぎにスペースを入れたいということですか。

補足

回答有難う御座います。
質問の時は、×にあわせてスペースを入れて入力したのですが・・・。
イメージは、スペースを＿をつけさせて頂きますと下記の様な感じです。
○＿＿＿＿１５０×＿１００×＿２００
□□＿＿＿＿＿＿＿＿＿５０×＿＿３０
△△△＿１０００×１０００×２０００
○、□、△はすべて全角（文字数は一定ではない状態）となります。
お手すきの時で構いませんので、ご指導の程宜しくお願い致します。