ExcelでA列に100件のデータがあるとします。各セルには文字列がはいっています。例えば、

" abc def hij klmn "
とあるとします。これを文字と文字の間がスペース1つであればそのまま。スペースが2つ以上ある場合はこれをスペース1つ分に変える。セルの先頭に空白があれば空白を無しにする。文字の終わりに空白があれば後ろの空白は全て削除するという方法です。VBAでできれば便利だと思うのですが、何かありましたらお教えください。ただし、各セルに入っているスペースはバラバラです。VBAで一発で変換できないかと悩んでいます。

上の文字列を
"abc def hij klmn"に置き換えたいです。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:
  • 終了:2009/02/18 22:20:08
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:SALINGER No.2

回答回数3454ベストアンサー獲得回数969

ポイント100pt

マクロのオプションから編集を選びショートカットを登録しておくと使うとき便利です。


Sub test()
    Dim lastRow As Long
    Dim i As Long
    Dim str1 As String
    Dim str2 As String
    
    '最終行の取得
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lastRow
        '前後の空白を削除して取得
        str1 = Trim(Cells(i, 1).Value)
        Do
            '空白2文字を1文字に置換を繰り返す
            str2 = Replace(str1, "  ", " ")
            
            '変化が無かったら抜ける
            If str1 = str2 Then
                Exit Do
            Else
                str1 = str2
            End If
        Loop
        
        'セルに書き戻し
        Cells(i, 1).Value = str1
    Next
End Sub

http://q.hatena.ne.jp/

id:akaired

いつもありがとうございます。助かりました!!

2009/02/18 22:19:42

その他の回答2件)

id:Mook No.1

回答回数1314ベストアンサー獲得回数393

ポイント50pt

下記を標準モジュールに置き、変換したい対象範囲を選択した状態で、

実行してみてください。

Sub main()
    Dim r As Range
    For Each r In Selection
        r.Value = clernupSpace(r.Value)
    Next
End Sub

Function cleanupSpace(r)
    res = Trim(r)
    l = 0
    Do While l <> Len(res)
        l = Len(res)
        res = Replace(res, "  ", " ")
    Loop
    clernupSpace = res
End Function

蛇足ですが、変換したいデータがA1にあった場合、B1などに

=cleanupSpace(A1)

としても利用できます。

http://excelvba.pc-users.net/

id:akaired

いつもありがとうございます。助かりました!!

2009/02/18 22:19:34
id:SALINGER No.2

回答回数3454ベストアンサー獲得回数969ここでベストアンサー

ポイント100pt

マクロのオプションから編集を選びショートカットを登録しておくと使うとき便利です。


Sub test()
    Dim lastRow As Long
    Dim i As Long
    Dim str1 As String
    Dim str2 As String
    
    '最終行の取得
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lastRow
        '前後の空白を削除して取得
        str1 = Trim(Cells(i, 1).Value)
        Do
            '空白2文字を1文字に置換を繰り返す
            str2 = Replace(str1, "  ", " ")
            
            '変化が無かったら抜ける
            If str1 = str2 Then
                Exit Do
            Else
                str1 = str2
            End If
        Loop
        
        'セルに書き戻し
        Cells(i, 1).Value = str1
    Next
End Sub

http://q.hatena.ne.jp/

id:akaired

いつもありがとうございます。助かりました!!

2009/02/18 22:19:42
id:SALINGER No.3

回答回数3454ベストアンサー獲得回数969

後から気がつきましたが、空白には半角と全角があるので、全角スペースにも対応させました。


Sub test()
    Dim lastRow As Long
    Dim i As Long
    Dim str1 As String
    Dim str2 As String
    
    '最終行の取得
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lastRow
        '前後の空白を削除して取得
        str1 = Trim(Cells(i, 1).Value)
        Do
            '空白2文字を1文字に置換を繰り返す
            str2 = Replace(str1, "  ", " ")
            str2 = Replace(str2, "  ", " ")
            '一見同じようなコードに見えますが
            '全角と半角スペースの違いがあるのでそのままコピーしてください
            str2 = Replace(str2, "  ", " ")
            str2 = Replace(str2, "  ", " ")
            
            '変化が無かったら抜ける
            If str1 = str2 Then
                Exit Do
            Else
                str1 = str2
            End If
        Loop
        
        'セルに書き戻し
        Cells(i, 1).Value = str1
    Next
End Sub

http://q.hatena.ne.jp/

  • id:airplant
    適当な列に次の関数を入れれば一発で余分なスペースを左右中間とも外しますが、VBAじゃないとだめでしょうか?
    =TRIM(A1)

    ちなみにマクロ否定派ではありません。笑
  • id:Mook
    本当だ。知りませんでした。

    VBA と 関数で、TRIM の仕様が違うんですね。
    勉強になりました。
  • id:SALINGER
    TRIM関数だと途中の空白を削除するのかと思ったら、空白1文字開けるのですね。
    しかも全角半角関係なしに。
    VBAからTRIM関数を使えばかなりすっきりしたコードになりますね。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません