人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

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

●質問者: akaired
●カテゴリ:コンピュータ インターネット
✍キーワード:ABC def Excel VBA とある
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● Mook
●50ポイント

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

実行してみてください。

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/

◎質問者からの返答

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


2 ● SALINGER
●100ポイント ベストアンサー

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


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/

◎質問者からの返答

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


3 ● SALINGER
●0ポイント

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


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/

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ