VBAで，特定の漢字が入っている行のみ，下のほうに

Question

ExcelのVBAでのソートについて教えていただきたいと思います。

行を並べ替える（２行目が見出し行なので，３行目以降）のですが，
或る列（C列）に特定の漢字が入っている行を，
一番下にしたいのですが，
どのようにすればよろしいでしょうか？

３行目以降のイメージとしては：

あい　う　　　え和えええ
おか　きき　　くけこ
さし　すすす　せそ和
たち　つて　　和となにぬねの
はひ　ふへ　　ほ

↓
おか　きき　　くけこ
はひ　ふへ　　ほ
あい　う　　　え和えええ
さし　すすす　せそ和
たち　つて　　和となにぬねの

上記の例のように，
「和」という文字がC列に含まれている行のみを下のほうに集め，
入っていない行を上のほうに集めたいのです。

上記はイメージなので，
実際は，
「特定の文字だけが漢字で，他はすべて平仮名」なんてことはありません。

「和」という文字がC列に含まれている行のみを下のほうに集めるという並べ替え前の
行の順序は，
必ずしも保たれている必要はありません。

Excel2000ですが，回答は他のバージョンでもいいです。
どのバージョンか断っていただくとこちらとしても参考になります。

Wendy02 · Accepted Answer

記録マクロでは細かいところは、ちょっと思うように行かないかもしれませんが、基本的にはには、並べ替えで出来るかと思います。

特定のバージョンのクレジットは付けませんが、その機能があればどのバージョンでも問題ありません。検索は、InputBox を取り付けてもよいと思います。

Sub Test1()
　Const sWORD As String = "和"
　Dim rng As Range
　Set rng = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)
　Application.ScreenUpdating = False
　With rng.Columns(3).Cells.Offset(, 1)
　　.Insert xlShiftToRight
　　.Offset(, -1).Formula = "=ISERROR(FIND(""" & sWORD & """,RC[-1]))"
　End With
　rng.Resize(, 4).Sort Key1:=rng.Cells(1, 4), _
　Order1:=xlDescending, _
　Header:=xlYes
　rng.Resize(, 4).Columns(4).Delete
　Application.ScreenUpdating = True
End Sub

tom04 · Answer

こんばんは！
すでに回答は出ていますので、参考程度で・・・

一例です。
「特定の文字」が変わってもいいように、INPUTBOXを使ってみました。

Sub test()
    Dim i As Long
    Dim str As String
    str = InputBox("特定文字を入力してください。")
    For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 3) Like "*" & str & "*" Then
        Range(Cells(i, 1), Cells(i, 3)).Cut
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
    End If
    Next i
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
    If Cells(i, 1) = "" Then
        Rows(i).Delete (xlUp)
    End If
    Next i
End Sub

こんな感じではどうでしょうか？m(__)m

hananoppo · Answer

次のようなマクロでよいと思います。

Sub DataSort()
    Dim PasteRow As Long
    Dim LastRow As Long
    Dim MatchCell As Range
    Dim CutRow As Long
    
    Application.ScreenUpdating = False
    PasteRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    For LastRow = PasteRow - 1 To 3 Step -1
        Set MatchCell = Range("C3:C" & LastRow).Find(What:="和", After:=Range("C" & LastRow), LookAt:=xlPart)
        If MatchCell Is Nothing Then
            Exit For
        Else
            CutRow = MatchCell.Row
            Rows(CutRow).Cut Rows(PasteRow)
            Rows(CutRow).Delete
        End If
    Next LastRow
    Application.ScreenUpdating = True
End Sub

このマクロはExcel 2000で作成しました。また、並び替え後も元の並び順が保たれるようにしています。

VBAで，特定の漢字が入っている行のみ，下のほうに

記録マクロでは細かいところは、ちょっと思うように行かないかもしれませんが、基本的にはには、並べ替えで出来るかと思います。

こんばんは！

次のようなマクロでよいと思います。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング