マクロ Trim

質問

A列に1500件ほどデータがあります。
左右、真ん中に余分なスペースがありそれを取りたいのですが、
Trim関数では左右の空白しか削除できません。
で、ググってみるとマクロを発見しました。以下です。
Sub 空白除去プログラム()
Dim abc As Range ‘セルを定義

For Each abc In Selection
abc = Trim(abc) ‘左右の空白を削除、「abc」を置き換える
　　Next

End Sub

勉強不足で、セルを定義できません。A1:A1500を定義したいのですが
どのように記述すればよいですか？また、このマクロに手を付け加えて、
今後、A1500以降にスペースを含む文字列が書かれたとき、
自動でスペースを削除するマクロに変更できますか？
どなたかお願いします。

回答No.7

Wendy02 · ベストアンサー

#6 の回答者です。
訂正です。
>処理に時間がかかりましたが、

自分の使っているマクロにこだわりがあったので、うっかりしていました。私のミスでした。#6 のhige_082さんのコードのように、配列する方法のほうが速いと思います。それで、コードを作り直してみました。

一応、回答の後だしですから、１行だけでも、可能なようにしておきました。
'-------------------------------------------

Sub SpaceErasing()
　　'5000行程度まで
　　Dim Ar As Variant
　　Dim i As Long
　　Dim buf As String
　　With ActiveSheet
　　　　Ar = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) 'A1 =Cells(1, 1)
　　　　Ar = Application.Transpose(Ar)
　　　　If IsArray(Ar) Then
　　　　　　For i = LBound(Ar) To UBound(Ar)
　　　　　　　　If IsError(Ar(i)) = False Then
　　　　　　　　　　Ar(i) = Replace(Ar(i), Space(1), "", , , vbTextCompare)
　　　　　　　　End If
　　　　　　Next
　　　　　　Ar = Application.Transpose(Ar)
　　　　　　.Cells(1, 1).Resize(UBound(Ar)).Value = Ar 'A1
　　　　Else
　　　　　　.Cells(1, 1).Value = Replace(Ar, Space(1), "", , , vbTextCompare)
　　　　End If
　　End With
End Sub

回答No.6

hige_082

回答は出てますが
Splitを使用した方法を紹介しておきます
と言うほどたいしたコードではありませんが．.笑

Sub 空白除去プログラム_test()
Dim abc As Variant
Dim def As Variant
Dim x As Long, y As Integer
abc = Range("A1", Range("A65536").End(xlUp))
For x = 1 To UBound(abc)
'半角空白除去
def = Split(abc(x, 1), " ")
abc(x, 1) = ""
For y = 0 To UBound(def)
abc(x, 1) = abc(x, 1) & def(y)
Next y
'全角空白除去
def = Split(abc(x, 1), "　")
abc(x, 1) = ""
For y = 0 To UBound(def)
abc(x, 1) = abc(x, 1) & def(y)
Next y
Next x
Range("A1", "A" & UBound(abc)) = abc
End Sub

配列を使用しているため、処理列(Ａ列)には２行以上データが必要です

以上参考まで

回答No.5

Wendy02

#3の回答者です。

>ありがとうございます。処理に時間がかかりましたが、

そうなんですね。処理がどうしても遅いのです。あれこれ考えたけれども、解決する手段がありません。全部が入っていないなら、

Const MYRNG As String = "A1:A1500"
On Error Resume Next
'こう書き換えればよいのですが……。
Set rng = Range(MYRNG).SpecialCells(xlCellTypeConstants, 23)
On Error Goto 0
Application.ScreenUpdating = False
　 For Each c In rng

なお、#4のimogasiさんのおっしゃるご指摘「スペースが見つからなくなるまで繰り返すほかない」は、私も別のVBAのテキストで同様の内容を読んだことがあります。

ワークシートとは違う挙動があります。私のコードは、一応、数年、いつも使っているものを元にして掲示しています。だから、Unicode スペースの削除も含まれています。いままで問題はありませんが、うまくないケースが存在するかもしれません。

回答No.4

imogasi

VB（VBA)のTrim関数は先頭と後尾のスペースしか取り除かないがよいの？
A1:J1000を捉えるだけなら
Range("A1:J1000").Select
Selection.・・
でよいが。
真中のスペースはVB（A)の場合はセルの文字列に対し、InStr関数でで見つけ削除して繰り返し、スペースが見つからなくなるまで繰り返すほかないと思う。
ーーー
あとエクセルVBAで編集ー置換の操作をして、マクロの記録を採るとかでコードはわかる。
検索する文字列　１スペース
置換後の文字列　何も入力しない
半角スペースと全角スペースは１度では置き換わらないかも知れない。簡単な１例でやって見ればわかる。
あとスペースではない、画面では見えない制御文字の存在は大丈夫かな。

回答No.3

Wendy02

こんにちは。

以下のコードのようにすると、Replace 関数は、全角・半角、両方が一度に削除できます。ChrW(160)は、Unicode スペースです。

>今後、A1500以降にスペースを含む文字列が書かれたとき、
>自動でスペースを削除するマクロに変更できますか？

自動的というのはやめたほうがよいかな？あえて書けないこともないけれども、ボタンを押したりして削除したほうが良いような気がします。
処理範囲としては、少し広すぎるかもしれません。
'-------------------------------------------
'実際に私が使っているものを加工してみました。
'VBA.Trim と書く必要がないけれども、ワークシート関数と見分けるために見かけで付けています。

Sub SpaceErasing()
　 Dim strVal As String
　 Dim c As Range
　 Dim Rng As Range
　 Const MYRNG As String = "A1:A1500"
　 Application.ScreenUpdating = False
　 For Each c In Range(MYRNG)
　　　strVal = Application.Clean(c.Value)
　　　strVal = Application.Substitute(strVal, ChrW(160), "")
　　　strVal = Replace(strVal, Space(1), "", , , 1)
　　　c.Value = VBA.Trim(strVal)
　 Next
　 Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。処理に時間がかかりましたが、無事できました！！

回答No.2

Trick--o--

> 左右、真ん中に余分なスペースがありそれを取りたいのですが
空白を消すだけなら、置換（Replace）を使用します

> A1:A1500を定義したいのですが
For Each ～ In ～
の使い方を調べましょう
この場合は
For Each abc In Range("A1:A1500")
でA1:A1500の範囲を捜査します

セルの値はRangeオブジェクトのValueを使用します
abc.Value = Replace(abc.Value," ","")
でabcの値から空白を削除してくれます

文字列を書いたときに自動でマクロを動かすには、イベントを使用します
調べてみませう

回答No.1

cistronezk

A列を選択して、Ctrl+Fで「検索と置換」画面を表示します。
「置換」タブで「検索する文字列」に「＜スペース＞」、「置換後の文字列」になにも入力しないいままで「すべて置換」を実行すれば、左右、真ん中のスペースが取り除かれます。