Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
セル内の空白行削除及びセル内の指定文字を含むセル内行の削除方法について
投稿日時: 21/06/04 00:28:09
投稿者: youkey14

お世話になります。
お分かりになる方、ご教示願います。
 
1,セル内の空白行の削除方法がありましたら、教えていただけませんでしょうか。
 
例(以下1つのセル内と仮定)
 
あいうえお
     ←この部分を削除したいです。
かきくけこ
さしすせそ
 
2,セル内の指定文字を含む行の削除方法がありましたら、教えていただけませんでしょうか。
 
例(以下1つのセル内と仮定)
 
あいうえお
かきくけこ
さしすせそ
さしすさしすさしすさしす
 
指定文字を"さしす"と仮に決めた場合、その行全体を削除する方法が知りたいです。
 
処理後
 
あいうえお
かきくけこ
 
※全て1つのセル内での処理となります。
お手数をおかけいたしますが、よろしくお願いいたします。

回答
投稿日時: 21/06/04 06:09:36
投稿者: simple

セル内改行は vbLfが使われていることはご存じでしょう。
 
質問にある「空白行」という用語は、

AAAvbLf
vbLf
BBB
のように、vbLFだけがある行の意味と解釈した。
つまり、半角スペースや全角空白があって空白行のように見えても、
それは対象外としている。
(その場合は、以下を理解した後、そちらで検討して下さい)
 
二つのFunctionプロシージャを作成した。
まず、testプロシージャで、その使い方を示した。
その下に、二つのFunctionプロシージャを載せている。
 
Sub test()  ' 使い方
    '(1)「空白行」の削除
    Range("B1") = deleteM(Range("A1"))  ' MはModifyのつもり
    
    '(2)特定文字列を含む行を削除
    Range("B2") = deleteM(Range("A2"), "さしす")
    
    '(3)自分自身を書き換えてもよい
    Range("A3").Value = deleteM(Range("A3"))
    Range("A4").Value = deleteM(Range("A4"), "さしす")
End Sub

'特定の文字列を含む一行(セル内の)を消去
Function deleteM(ByVal s As String, Optional specialStr As String = "") As String
    Dim ary As Variant
    Dim e As Variant
    Dim k As Long

    If specialStr <> "" Then
        ary = Split(s, vbLf)
        k = 0
        For Each e In ary
            If InStr(e, specialStr) > 0 Then
                ary(k) = ""
            End If
            k = k + 1
        Next
        deleteM = delete2LF(Join(ary, vbLf))
    Else
        deleteM = delete2LF(s)
    End If
End Function

'連続した vbLfをひとつのvbLfに変換
Function delete2LF(ByVal s As String) As String
    Do While InStr(s, vbLf & vbLf) > 0
        s = Replace(s, vbLf & vbLf, vbLf)
    Loop
    '最後がvbLfで終わる場合はそれをカット
    If Right(s, 1) = vbLf Then s = Left(s, Len(s) - 1)
    delete2LF = s
End Function

なお、ユーザー定義関数としても使えるはずです。
また、「折り返して全体を表示」にしないとセル内改行が有効にならないことに注意。

回答
投稿日時: 21/06/04 08:01:56
投稿者: WinArrow
投稿者のウェブサイトに移動

当該セルで置換を実行する方法を提案します。
 

セルA1に
AAAAvblf
BBBvbfl
vblf
CCC
というデータが入っている仮定して
 
    Range("A1").Replace vbLf & vbLf, vbLf
 

投稿日時: 21/06/04 20:06:31
投稿者: youkey14

早速メッセージありがとうございます。
試してみましたが、思ったような内容で実行されませんでした。
 
恐らく私の説明不足かと思いますので、
もう一度私が実行したい内容を事細かく説明いたします。
 
@セル内の空白行(vbLf)の削除
 
実行前
 
A1セル

あいうえお

かきくけこ
さしすせそ

たちつてと

 
実行後
 
A1セル
あいうえお
かきくけこ
さしすせそ
たちつてと

 
Aセル内の特定の文字列を含む一行を削除
※ここでは「サイズ」と「原産国」を特定文字列とする
 
実行前
 
B1セル
カラー:ブラック
サイズ:10x10x10
素材:ポリエステル
原産国:日本

 
実行後
 
B1セル
カラー:ブラック
素材:ポリエステル

 
このようなイメージですが、同様の回答となる場合は、完全にこちらの基礎知識不足ですので、勉強しなおします。
お手数をおかけしますが、再度ご確認よろしくお願いいたします。

回答
投稿日時: 21/06/04 20:51:50
投稿者: simple

コードを提示した張本人です。
どのように実行されたのか、コードを示してもらえますか?
また、ユーザー定義関数として使ったのであれば、どこにどのような形で使っていますか?
 
そして、それぞれの例での結果(こんなことになってしまったんですよ、という奴)を示して下さい。

投稿日時: 21/06/04 21:47:19
投稿者: youkey14

ありがとうございます。
先に示していただいたコードの通り、入力いたしました。
 
B1セル

あいうえお

かきくけこ
さしすせそ

たちつてと

 
Sub test()  ' 使い方
    '(1)「空白行」の削除
    Range("B1") = deleteM(Range("A1"))  ' MはModifyのつもり
    
End Sub

 
Functionも示していただいたとおりに設定いたしました。
 
結果は、A1セルに入力されている文字がB1に置換されたというような状況です。
よろしくお願いいたします。
[/code]

投稿日時: 21/06/04 22:01:37
投稿者: youkey14

失礼いたしました。
 
A1セル
特に何も入力なし
 
B1セル

あいうえお

かきくけこ
さしすせそ

たちつてと

 
実行コード
Sub test()  ' 使い方
    '(1)「空白行」の削除
    Range("B1") = deleteM(Range("A1"))  ' MはModifyのつもり
    
End Sub

 
結果
B1セルにはA1セルが入力されました。
 
私が求めているのは、B1セル内の空白行を削除することです。
 
すみません。
何度も。
このような書き方でよろしかったでしょうか。
如何せん、VBA初心者なので説明の仕方も分からなくて。
申し訳ないです。

回答
投稿日時: 21/06/04 22:13:16
投稿者: simple

その test というマクロは、
 ・A1セルの文字列を対象として、そのなかの空白行を削除し、
 ・その結果を、B1セルに記入する
というものですよ。
元の文字列をA1セルに入れないと意味がありません。
頑張ってみてください。

回答
投稿日時: 21/06/04 22:18:50
投稿者: simple

>私が求めているのは、B1セル内の空白行を削除することです。
そうであれば、

引用:
'(3)自分自身を書き換えてもよい
    Range("A3").Value = deleteM(Range("A3"))
と書いたように、
     
    Range("B1").Value = deleteM(Range("B1"))  
とすればOKです。

回答
投稿日時: 21/06/04 22:40:50
投稿者: simple

私の手元ではもちろんうまく動作することを確認してコードは提示しています。
もしうまくいかなければ、データですかね。
 
お手数ですが、
元の文字列をA1セルに入力し、
・C1セルに
    =CODE(MID($A$1,ROW(),1))
  と入力
・以下、それを下にコピーペイストしてください。
・エラーになるまでのところの結果を
  こちらにそのまま貼り付けてもらえますか?

投稿日時: 21/06/04 22:44:56
投稿者: youkey14

大変失礼いたしました。
基礎知識をもう少し学んでから質問すべきでした。
ご丁寧にありがとうございます。
  
思っていた通りに動いてとても感動しています。
  
ただ、2点だけ追加でお伺いしてもよろしいでしょうか。
  
A1セル

あいうえお
かきくけこ

さしすせそ

 
  
実行コード
Sub test() ' 使い方
 
    '(2)特定文字列を含む行を削除
    Range("B1") = deleteM(Range("A1"), "あいう")
 
    '(1)「空白行」の削除
    Range("C1") = deleteM(Range("B1")) ' MはModifyのつもり
 
End Sub

  
結果
B1セル
 
かきくけこ
さしすせそ

  
C1セル
 
かきくけこ
さしすせそ

 
となり、削除した行を消すことができませんでした。
  
また、特定の文字列が"あいう"と"さしす"の場合にもどのようにすべきかご教示いただけませんでしょうか。
  
私の分かる知識内で色々試してみましたが、ダメでした。
  
試した実行コード
 
Sub test() ' 使い方
 
    '(2)特定文字列を含む行を削除
    Range("B1") = deleteM(Range("A1"), "あいう")
    Range("B1") = deleteM(Range("A1"), "さしす")
 
    '(1)「空白行」の削除
    Range("C1") = deleteM(Range("B1")) ' MはModifyのつもり
 
End Sub

 
Sub test() ' 使い方
 
    '(2)特定文字列を含む行を削除
    Range("B1") = deleteM(Range("A1"), "あいう" & "さしす")
 
    '(1)「空白行」の削除
    Range("C1") = deleteM(Range("B1")) ' MはModifyのつもり
 
End Sub

  
すみません。何度も。
正直空白行消せただけでも非常に感動しておりますが、お手すきの時にご教示いただければとても嬉しいです。
よろしくお願いいたします。

投稿日時: 21/06/04 22:48:21
投稿者: youkey14

youkey14 さんの引用:
大変失礼いたしました。
基礎知識をもう少し学んでから質問すべきでした。
ご丁寧にありがとうございます。
  
思っていた通りに動いてとても感動しています。
  
ただ、2点だけ追加でお伺いしてもよろしいでしょうか。
  
A1セル
あいうえお
かきくけこ

さしすせそ

 
  
実行コード
Sub test() ' 使い方
 
    '(2)特定文字列を含む行を削除
    Range("B1") = deleteM(Range("A1"), "あいう")
 
    '(1)「空白行」の削除
    Range("C1") = deleteM(Range("B1")) ' MはModifyのつもり
 
End Sub

  
結果
B1セル
 
かきくけこ
さしすせそ

  
C1セル
 
かきくけこ
さしすせそ

 
となり、削除した行を消すことができませんでした。
  
また、特定の文字列が"あいう"と"さしす"の場合にもどのようにすべきかご教示いただけませんでしょうか。
  
私の分かる知識内で色々試してみましたが、ダメでした。
  
試した実行コード
 
Sub test() ' 使い方
 
    '(2)特定文字列を含む行を削除
    Range("B1") = deleteM(Range("A1"), "あいう")
    Range("B1") = deleteM(Range("A1"), "さしす")
 
    '(1)「空白行」の削除
    Range("C1") = deleteM(Range("B1")) ' MはModifyのつもり
 
End Sub

 
Sub test() ' 使い方
 
    '(2)特定文字列を含む行を削除
    Range("B1") = deleteM(Range("A1"), "あいう" & "さしす")
 
    '(1)「空白行」の削除
    Range("C1") = deleteM(Range("B1")) ' MはModifyのつもり
 
End Sub

  
すみません。何度も。
正直空白行消せただけでも非常に感動しておりますが、お手すきの時にご教示いただければとても嬉しいです。
よろしくお願いいたします。

 
最後に書いた"あいう"と"さしす"ですが、
結果はこうなっていてほしいです。
 
C1セル
かきくけこ

 
よろしくお願いいたします。

回答
投稿日時: 21/06/04 23:03:04
投稿者: simple

ああ、たしかに見落としていましたね。
少し時間を貰いたい。

投稿日時: 21/06/04 23:04:24
投稿者: youkey14

すみません。
よろしくお願いいたします。

回答
投稿日時: 21/06/05 07:06:23
投稿者: simple

がらっと変えてFilter関数を使ってみました。
 
・必要なのは、下記のdeleteFだけです。
・今度のは、指定したセルを直接、上書き更新します。
  必要なら、どこかにバックアップをとっておいてください。
・下記の使い方に示していますが、
  削除したい行を示す特定文字列は、引数(複数可能)で指定する方式です。
 

Sub test()  ' 使い方の説明
    '(1)
    Call deleteF(Range("A1"))               '「空白行」のみの削除
    Call deleteF(Range("A2"), "あいう")
    Call deleteF(Range("A3"), "たちつ", "あいう") ' いくつ特定文字列を指定しても可

    '(2) こういう書き方も可
    deleteF Range("A1")
    deleteF Range("A2"), "あいう"
    deleteF Range("A3"), "たちつ", "あいう"
    
    '(3)セル範囲を一括して置換する場合
    Dim r As Range
    For Each r In Range("A1:A10")
        Call deleteF(r, "あいう")
    Next
End Sub

Function deleteF(rng As Range, ParamArray otherArgs()) 
    Dim s       As String
    Dim ary     As Variant
    Dim ary2()  As String  '削除後の各行の文字列からなる配列
    Dim e       As Variant
    Dim k       As Long
    
    ary = Split(rng.Value, vbLf)
    
    '(1)空白行を排除した配列ary2を作成
    k = 0
    For Each e In ary
        If e <> "" Then
            ReDim Preserve ary2(k)
            ary2(k) = e
            k = k + 1
        End If
    Next
    
    '(2)特定文字列がある行を削除
    If UBound(otherArgs) > -1 Then
        For Each e In otherArgs
            ary2 = Filter(ary2, e, False) '特定文字列を含まないものを抽出
        Next
    End If
    rng.Value = Join(ary2, vbLf)
End Function

一応動作確認はしていますが、エッジケースで不備があるかもしれません。
なお、仕様追加は基本的に考えていません。別の方にお願いします。

投稿日時: 21/06/05 08:07:19
投稿者: youkey14

素晴らしすぎて朝から興奮しています!
とても感謝します。
また次回質問させていただく際には、もう少し基礎知識レベルを上げてからにしようと思います。
この度はありがとうございました。