Excelで文字を変換,結合,分割をする。

質問

セルA１に[火1]
セルA2に[火1,火2,水1,水2,木1,木2]
セルA3に[水3,水4,水5]
が入っているとします。それを
セルB1に[火1]
セルB2に[火1～2]セルC2に[水1～2]セルD2に[木1～2]
セルB3に[水1～3]
と入力したいと思っています。
関数で対応できますでしょうか？
もしくは、カンマ区切りでデータを割った後に関数でしょうか？
一番効率のよい方法を教えてください。

回答No.1

tom04 · ベストアンサー

こんばんは！
無理矢理って感じのVBAでやってみました。

↓の画像のようにA列の1行目からデータがあるとします。

（1）数字の前は一文字とし、同じ文字である。
（2）文字の後の数値は続き番号になっている。

という前提です。

画面左下にある操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, j, k As Long
Dim myArray As Variant
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
myArray = Split(Cells(i, 1), ",")
k = UBound(myArray)
For j = 2 To k + 2
Cells(i, j) = myArray(j - 2)
Next j
Next i
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = Cells(i, Columns.Count).End(xlToLeft).Column To 3 Step -1
If Left(Cells(i, j - 1), 1) = Left(Cells(i, j), 1) Then
Cells(i, j) = Mid(Cells(i, j), 2, Len(Cells(i, j)))
End If
Next j
Next i
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = Cells(i, Columns.Count).End(xlToLeft).Column To 3 Step -1
If IsNumeric(Cells(i, j)) And IsNumeric(Cells(i, j - 1)) Then
Cells(i, j - 1).Delete (xlToLeft)
End If
Next j
Next i
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = Cells(i, Columns.Count).End(xlToLeft).Column - 1 To 2 Step -2
Cells(i, j) = Cells(i, j) & "～" & Cells(i, j + 1)
Cells(i, j + 1).Delete (xlToLeft)
Next j
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

※　じっくり考えればもう少し簡単なコードになるかもしれません。
他に良い方法があればごめんなさいね。m（＿ ＿）m

お礼

ありがとうございます。　完璧でした。
私も勉強したいです。