[[20100917230714]]　『セル内の空白行を削除』（てつ）　ページの最後に飛ぶ

『セル内の空白行を削除』（てつ）

 他からエクセルに取り込んだデータについて
 多くのセルの中に空白行がたくさんあるので、削除したいと思います。
 改行を全て取り除くことは、簡単にできるのですが、
 空白行のみ取り除くことができません。
 どのようなマクロを使えば、良いのでしょうか。
 Excel2010　XPで利用しています。
 よろしくお願いいたします。

 文字があかさたなはまやらわ順になるのでよければ使えますよ。
 Sub 並び替え()
    Range("A1:A30").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin, DataOption1:=xlSortNormal
    Range("A1").Select
 End Sub
 (めろんぱん)

 わかりにくい書き方ですいません。
 それぞれのセルの中で、
 例えば
 　「○○○
 　　○○○

 　　○○○
 　　○○」
 というようにあるのを
 セル内の空白行を取り除きたいと思っているのです。
 よろしくお願いします。
 　（てつ）

 ◆マクロではありませんが、こんな方法はいかがでしょう
 １）「Ctrl＋H」を押して、「検索と置換のダイアログボックス」の
 ２）「検索する文字列」に「Ctrl＋J」を２回入力して（表示はされません）
 ３）「置換後の文字列」に「Ctrl＋J」を１回入力して、「すべて置換」をクリックします
 (Maron)

 このようなものはいかがでしょう?
 Maronさんが書いたように、改行「chr(10)」が2個連続するときは
 1個に置き換えるという方法です。　　(Hatch)
Sub test()
    Dim myRange As Range
    Dim r As Range
    Set myRange = Range("A1:A10")
    For Each r In myRange
        r.Value = Replace(r.Value, Chr(10) & Chr(10), Chr(10))
    Next r
End Sub

 時間が空いたので出てきました。。
 Maronさん、Hatchさんを参考にさせて頂き、、
 空白行が連続したり、先頭や最後尾にあった時を考慮して、、

 Sub test_2()
    Dim myRange As Range
    Dim r As Range

    Set myRange = Range("A1:A10")
    For Each r In myRange
        Do Until InStr(1, r, Chr(10) & Chr(10), vbTextCompare) = 0
            r.Value = Replace(r.Value, Chr(10) & Chr(10), Chr(10))
        Loop
        If Left(r, 1) = Chr(10) Then r.Value = Right(r, Len(r) - 1)
        If Right(r, 1) = Chr(10) Then r.Value = Left(r, Len(r) - 1)
    Next r
 End Sub
 (kei)

 みなさんに教えていただいた方法でやってみたのですが、
 なかなかうまくいきません。
 メールの本文を取り込んだデータですので、
 規則性がありません。
 空行が２つ以上続いていたり、
 途中の行頭に空白の全角や半角の文字があったり
 教えていただいたことをもとに
 少し換えてやってみるのですが、今のところ目途が立ちません。
 改行が２つ続くところでは、改行が１つになるはずなのですが、
 それもうまくできないところがあります。
 メールを取り込んだデータというところに何か問題があるのでしょうか。
 （てつ）

 なお、(Maron)さんに教えていただいた
 置換を使った場合、
 一致するデータが見つかりません
 という表示が出てきます。
 でも確かにテキストに貼り付けると、
 改行が２つ続いているところがあるのですが。
 （てつ）

 半角や全角の空白を無くしてから処理すると良いのでしょうが、必要な空白まで無くなるかも。。
 それで良いのなら原本を保存してから、下記で実行してみて。

 Sub test_3()
    Dim myRange As Range
    Dim r As Range

    Set myRange = Range("A1:A10")
    With myRange
        .Replace what:=" ", Replacement:=""
        .Replace what:="　", Replacement:=""
    End With
    For Each r In myRange
        Do Until InStr(1, r, Chr(10) & Chr(10), vbTextCompare) = 0
            r.Value = Replace(r.Value, Chr(10) & Chr(10), Chr(10))
        Loop
        If Left(r, 1) = Chr(10) Then r.Value = Right(r, Len(r) - 1)
        If Right(r, 1) = Chr(10) Then r.Value = Left(r, Len(r) - 1)
    Next r
 End Sub
 (kei)

 keiさんに教えていただいたマクロを実行しました。
 確かに、空白文字はなくなるのですが、
 空白行は、そのままになっています。
 空白文字をなくしてから、マクロを実行しても、
 やはり空白行は残っています。
 （てつ）

 どうしてもできないのなら、何か特殊な文字が混入していると思います。。
 そのセルを他のシートのA1にコピペして、
 B1=IF(LEN($A$1)>=ROW(A1),CODE(MID($A$1,ROW(A1),1)),"")
 この数式をずーと下までコピペしてみて。。
 うまくいけば、文字コードが分かるかも。。
 (kei)

 文字コードの解析は、どうでしたか?
 悪名高い^^; CHR(160)だったら、下記のコードで処理できるかなぁ。。
 作業列をZ列にしていますが、問題なら他の範囲に書き換えて実行してください。

 Sub test_3()
    Dim myRange As Range
    Dim r As Range

    Set myRange = Range("A1:A10") '←データ範囲のセル範囲を修正してね。
    With Range("Z1:Z10")          '←この場合Z列を作業列にしています。セル範囲の修正を。。
        .Value = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,CHAR(160),""""),"" "",""""),""　"","""")"
    End With
        myRange.Value = Range("Z1:Z10").Value  '←セル範囲の修正を。。
        Range("Z1:Z10").Value = ""             '←セル範囲の修正を。。
    For Each r In myRange
        Do Until InStr(1, r, Chr(10) & Chr(10), vbTextCompare) = 0
            r.Value = Replace(r.Value, Chr(10) & Chr(10), Chr(10))
        Loop
        If Left(r, 1) = Chr(10) Then r.Value = Right(r, Len(r) - 1)
        If Right(r, 1) = Chr(10) Then r.Value = Left(r, Len(r) - 1)
    Next r
 End Sub
 (kei)

 keiさん
 文字コード解析は、うまくいきませんでした。
 改行コードをネットで調べていて、
 vbCrLf となる場合があることが分かり、
 Chr(10)の部分を、これに入れ替えて、教えていただいた
 マクロを次のようにしました。
    Do Until InStr(1, r, vbCrLf & vbCrLf, vbTextCompare) = 0
        r.Value = Replace(r.Value, vbCrLf & vbCrLf, vbCrLf)
    Loop
 無事、これによって、うまくいきました。
 ありがとうございました。
 （てつ）

コメント返信：

[ 一覧(最新更新順) ]

[[20100917230714]] 『セル内の空白行を削除』（てつ） ページの最後に飛ぶ

[[20100917230714]]　『セル内の空白行を削除』（てつ）　ページの最後に飛ぶ