「クソ」としか言いようのない魔Excelに勝利した
クソのようなExcel様式に打ち勝った
クソとしか言いようのないExcel様式
「クソ」としか言いようのないExcel様式に出会った。
簡単に言うと、
1つのセルに複数データが入っている
というもの。
しかも、[Alt]+[Enter]によるセル内改行ばかりかと思ったら、スペース連打で成り行き改行まで含まれている始末。
一瞬、軽く途方に暮れかけたが、幸い改行のしかたはともかくとして、全て箇条書きの体になっていたので、それらを1セル1データになるようにする方法を考えた。
1セル1データに整形するための考え方
次のように考えた。
- 改行記号を「@」(データ文字列内に決して出てこない記号)に置き換える
- 2つ以上連なっているスペースも「@」に置き換える
- 2つ以上「@」が連なっている部分を「@」が1つになるまで置き換える
ここまでで、必要なデータが間に「@」が挟まった状態で1つの文字列になっているはず。 - Split関数で各データを配列に格納する。
- (データ数-1)行、挿入する
- データをセルに書き込んでいく
このような手順。
実装
リスト1
Public Sub splitStrings() Dim Sh As Worksheet Set Sh = ActiveSheet Dim objCell As Range Set objCell = ActiveCell Dim str As String str = objCell.Value str = Replace(str, vbCrLf, "@") '……(1)' str = Replace(str, vbCr, "@") str = Replace(str, vbLf, "@") str = Replace(str, " ", "@") '半角スペース2つ' str = Replace(str, " ", "@") '半角スペースと全角スペース' str = Replace(str, " ", "@") '全角スペースと半角スペース' str = Replace(str, " ", "@") '全角スペース2つ' Do While InStr(str, "@@") > 0 '……(2)' str = Replace(str, "@@", "@") Loop Dim arrayStr As Variant '……(3)' arrayStr = Split(str, "@") Dim i As Integer '……(4)' For i = 1 To UBound(arrayStr) Sh.Rows(objCell.Row + i).Insert shift:=xlShiftDown Next For i = 0 To UBound(arrayStr) '……(5)' With objCell.Offset(i, 0) .Value = arrayStr(i) End With Next End Sub
まず、(1)からの7行、
str = Replace(str, vbCrLf, "@") str = Replace(str, vbCr, "@") str = Replace(str, vbLf, "@") str = Replace(str, " ", "@") '半角スペース2つ' str = Replace(str, " ", "@") '半角スペースと全角スペース' str = Replace(str, " ", "@") '全角スペースと半角スペース' str = Replace(str, " ", "@") '全角スペース2つ'
では、変数strに格納したセル内の文字列について、改行記号や2つ連なったスペースを「@」に置換している。
そして、(2)からの3行、
Do While InStr(str, "@@") > 0 str = Replace(str, "@@", "@") Loop
では、2つ以上の「@」の連なりがある限り「@@」を「@」に置換する、という処理を行っている。従って、このループ処理を抜けると、
もともと改行記号や2つ以上のスペースで区切られていた複数の文字列が「@」1つで区切られた状態の文字列
になっているということ。
あとは、(3)からの2行
Dim arrayStr As Variant arrayStr = Split(str, "@")
で「@」で区切られた文字列をSplit関数でバラして配列変数arrayStrに突っ込み(要素数が未確定なのでVariant型の変数で受ける)、
(4)からの4行、
Dim i As Integer For i = 1 To UBound(arrayStr) Sh.Rows(objCell.Row + i).Insert shift:=xlShiftDown Next
で必要な数だけ行を挿入し、
(5)からの5行、
For i = 0 To UBound(arrayStr) With objCell.Offset(i, 0) .Value = arrayStr(i) End With Next
でそれぞれ1セル1データの形で書き込んでおしまい。
実行結果
こんなふうにアホみたいに書き込まれた5つのデータ。
見た目では分からないが、③と④の間は、セル内改行ではなくスペース連打による見かけ上の改行w
こんなデタラメなデータでも、このセルを選択してマクロを実行すると、
ほれ、この通り。1セル1データになった。
ちなみに、
こんなふうに、セル内改行連打の場合でも、
大丈夫です。
おわりに
それにしても、アクロバチックなExcelの使い方をする人が多すぎて、マジでメンタルやられそうです。。。