Excelで作った表を印刷するとセル内の文字列の末尾が欠けてしまうことありませんか？
私は、Excel2000を使っていてこの現象に何度も出くわして、行幅を調整して印刷しなおすという手間を何度もかけることがあります。
セルの右端に届きそうな位置で文字列が終わる場合によく起きる現象です。
原因は、画面に表示されるときの文字間と印刷されるときの文字間が微妙にずれていることにあります。
ワークシートが以下のようになっていたとします
印刷ブレビューを見ると右下のセル内の文字が欠けてしまっています。また、セル内の文字の配置が統一されてないように見えます。
セルの書式設定で、文字列の配置は、上詰め、左詰め としているにもかかわらず、この配置の悪さは、文字列の先頭や末尾に無駄な改行やスペースが入っているのが原因です。入力作業者が複数居ると、各自の癖の違いで、こんなことになったりします。
表の規模が小さいときは、手作業で修正すれば済むのですが、ある日、何１００行もある表を扱うことになり、作業にかかる膨大な時間を想うと気が遠くなりそうでした。
ここはひとつ、マクロで自動処理するしかないと思い、ほとんど知らないマクロプログラミングに挑戦してみました。
処理の概要は以下のようにしました。
選択範囲の各セルの文字列に対し、
１．先頭に改行、全角スペース、半角スペースがあれば削除する。
２．末尾に改行、全角スペース、半角スペースがあれば削除する。
３．末尾に改行を１個だけ付与する。
４．空セルに対しては何もしない。
３番目の「末尾に改行を１個だけ付与する」理由は、空行が１つ追加されることにより、行幅が自動的に割増されて文字が欠けるということが回避されるからです。
労作のテストが無事終わり、一応満足のいく動作をするようになりました。
使い方は以下のようにしてます。
まず、処理対象の領域を選択します
登録しておいたマクロを実行します
処理結果がワークシートに一瞬で反映されました。スッキリしてます。
印刷プレビューもいいかんじです。
下記に、作成したVBAプログラムを記載しておきます。
Sub 改行とスペース整理()
'仕様
'選択範囲の各セルの文字列に対し、
'１．先頭に改行、全角スペース、半角スペースがあれば削除する。
'２．末尾に改行、全角スペース、半角スペースがあれば削除する。
'３．末尾に改行を１個だけ付与する。
'４．空セルに対しては何もしない。
Dim R As Range
Dim i As Integer
Dim a As String
Dim b As String
Dim aLen As Integer
For Each R In Selection
a = R.Value 'Valueとすることで255文字を超えても扱える(Textは255文字まで)
aLen = Len(R.Value)
'For i = 1 To aLen 'テスト用
' MsgBox Asc(Mid(a, i, 1)) '文字のアスキーコードを表示させるテスト
'Next i
If aLen = 0 Then 'セルの中が空っぽなら次のセルへ移動
GoTo loop3
End If
loop1:
b = Left(a, 1)
If b = Chr(10) Or b = Chr(-32448) Or b = Chr(32) Then
a = Right(a, aLen - 1) 'bが改行、全角スペース、半角スペースなら、削除。loop1に飛ぶ
aLen = aLen - 1
GoTo loop1
End If
loop2:
b = Right(a, 1)
If b = Chr(10) Or b = Chr(-32448) Or b = Chr(32) Then
a = Left(a, aLen - 1) 'bが改行、全角スペース、半角スペースなら、削除。loop2に飛ぶ
aLen = aLen - 1
GoTo loop2
End If
a = a & Chr(10) '末尾に改行追加
aLen = aLen + 1
R.Value = a 'aをセルに格納する
loop3:
Next R
End Sub