アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

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

End Sub

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

A 回答 (7件)

#6 の回答者です。


訂正です。
>処理に時間がかかりましたが、

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

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

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
    • good
    • 0

回答は出てますが


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

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

以上参考まで
    • good
    • 0

#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 スペースの削除も含まれています。いままで問題はありませんが、うまくないケースが存在するかもしれません。
    • good
    • 0

VB(VBA)のTrim関数は先頭と後尾のスペースしか取り除かないがよいの?


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

こんにちは。



以下のコードのようにすると、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
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/10/23 13:27

> 左右、真ん中に余分なスペースがありそれを取りたいのですが


空白を消すだけなら、置換(Replace)を使用します

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

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


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

A列を選択して、Ctrl+Fで「検索と置換」画面を表示します。


「置換」タブで「検索する文字列」に「<スペース>」、「置換後の文字列」になにも入力しないいままで「すべて置換」を実行すれば、左右、真ん中のスペースが取り除かれます。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!