[[20230324095704]]　『フィルターなどを使わず抜き出したい』（初心者）　ページの最後に飛ぶ

『フィルターなどを使わず抜き出したい』（初心者）

例えば下の表があるとします、

図１

    _A列_   _B列_　　  _C列_　　　　　　　
 1  遊園地  駅直結    ジェットコースター
 2　水族館  　　　　　ペンギン
 3  植物園  車必須　　ラフレシア
 4　動物園 　　　　　 シロクマ
 5　美術館  5年ぶり   ジャコメッティ

並べ替えとフィルターを使わずにB列の文字や数値が入っている行だけ一番上にすることはできますか？

↓こうしたい

図２

    _A列_   _B列_　　  _C列_　
 1  遊園地  駅直結    ジェットコースター
 3  植物園  車必須　　ラフレシア
 5　美術館  5年ぶり   ジャコメッティ
 2　水族館  　　　　　ペンギン
 4　動物園 　　　　　 シロクマ

なお、D列以降と6行目以降も複数の関連性のない文字が入っています。

＜使用 Excel：Excel2021、使用 OS：Windows10 ＞

 別のシートにコピーして並べ替えた後、貼り付け直せばいいんじゃ？
（稲葉） 2023/03/24(金) 10:23:41

＞並べ替えとフィルターを使わずに
その理由は?
（もったいない） 2023/03/24(金) 10:52:19

 E2 =SORT(IF(A1:C5="","",A1:C5),2,-1)
（フォーキー） 2023/03/24(金) 11:52:49

すみません、数式を入れるのはE1セルでした。
あと、「文字や数値が入っている行だけ一番上」はできますが、希望の並びにはならないです。

    |[E]   |[F]    |[G]               
 [1]|植物園|車必須 |ラフレシア        
 [2]|遊園地|駅直結 |ジェットコースター
 [3]|美術館|5年ぶり|ジャコメッティ    
 [4]|水族館|       |ペンギン          
 [5]|動物園|       |シロクマ          
（フォーキー） 2023/03/24(金) 11:56:32

 >D列以降と6行目以降も複数の関連性のない文字が入っています。
見落としてました。

マクロ以外だと稲葉さんの回答になると思います。
（フォーキー） 2023/03/24(金) 12:03:27

何度もすもません。

 >並べ替えとフィルターを使わずに
これも見落としてました。（タイトルも同じにしてほしいです・・・）
私の回答は無視してください。
（フォーキー） 2023/03/24(金) 12:07:41

 空白を詰めるフィルターってことかしら？
    Sub test()
        Dim v1 As Variant, v2 As Variant
        Dim x As Variant, y As Variant
        Dim xx As Variant, yy As Variant
        Dim i As Long
        x = Filter([transpose(if(row(1:5),if(b1:b5="",char(2),row(1:5))))], Chr(2), False)
        y = Filter([transpose(if(row(1:5),if(b1:b5="",row(1:5),char(2))))], Chr(2), False)

        v1 = Range("A1:C5").Value
        v2 = v1
        i = 0
        For Each xx In x
            i = i + 1
            v2(i, 1) = v1(xx, 1)
            v2(i, 2) = v1(xx, 2)
            v2(i, 3) = v1(xx, 3)
        Next xx
        For Each yy In y
            i = i + 1
            v2(i, 1) = v1(yy, 1)
            v2(i, 2) = v1(yy, 2)
            v2(i, 3) = v1(yy, 3)
        Next yy
        Range("A1:C5").Value = v2
    End Sub
（稲葉） 2023/03/24(金) 14:02:41

    Dim bMax As Long
    Dim bDst As Long
    Dim iRow As Long
    bMax = Cells(Rows.Count, "B").End(xlUp).Row
    For iRow = 2 To bMax
        If Cells(iRow, "B").Value = "" Then
            If bDst < 1 Then bDst = iRow
        Else
            Cells(iRow, "A").EntireRow.Cut
            Cells(bDst, "A").EntireRow.Insert Shift:=xlDown
            iRow = bDst
            bDst = 0
        End If
    Next

禁断のループ数上書きを使う方法
（火災報知器） 2023/03/24(金) 15:21:39

    Dim bMax As Long
    Dim bTgt As Long
    Dim iRow As Long
    bMax = Cells(Rows.Count, "B").End(xlUp).Row
    For iRow = 2 To bMax
        If Cells(iRow, "B").Value = "" Then
            bTgt = Cells(iRow, "B").End(xlDown).Row
            If bTgt > bMax Then Exit For
            Cells(bTgt, "B").EntireRow.Cut
            Cells(iRow, "B").EntireRow.Insert Shift:=xlDown
        End If
    Next

禁じ手抜きの別バージョン
（火災報知器） 2023/03/24(金) 15:37:23

 火災報知器さん
 ＞なお、D列以降と6行目以降も複数の関連性のない文字が入っています。
 らしいんで
 ＞            Cells(bTgt, "B").EntireRow.Cut
 ＞            Cells(iRow, "B").EntireRow.Insert Shift:=xlDown
 はだめかも・・・
 新規シートにコピーしてからやっちまったほうが早そうっすね
（稲葉） 2023/03/24(金) 15:51:10

稲葉さんご指摘ありがとうございます。
6行目以降、D列以降も移動させる対象なのかと勘違いしました。

上記2コードは破棄でお願いします。
（火災報知器） 2023/03/24(金) 16:03:51

    Dim bMax As Long
    Dim bTgt As Long
    Dim iRow As Long
    bMax = 5
    For iRow = 1 To bMax
        If Cells(iRow, "B").Value = "" Then
            bTgt = Cells(iRow, "B").End(xlDown).Row
            If bTgt > bMax Then Exit For
            Cells(bTgt, "A").Resize(, 3).Cut
            Cells(iRow, "A").Resize(, 3).Insert Shift:=xlDown
        End If
    Next

A～C列、1～5行に限定
（火災報知器） 2023/03/24(金) 16:08:59

 参考出品
 Sub sample()
  [A1:C5] = [VSTACK(FILTER(A1:C5,B1:B5<>""),FILTER(A1:C5,B1:B5=""))]
 End Sub
（´・ω・`） 2023/03/25(土) 12:57:52

 VSTACK関数は2021にはないですか、、、
（´・ω・`） 2023/03/25(土) 13:09:10

 もしSORTBYが使えれば
=SORTBY(IF(A1:C5="","",A1:C5),B1:B5="")
（んなっと） 2023/03/25(土) 18:45:38

コメント返信：

[ 一覧(最新更新順) ]

[[20230324095704]] 『フィルターなどを使わず抜き出したい』（初心者） ページの最後に飛ぶ

[[20230324095704]]　『フィルターなどを使わず抜き出したい』（初心者）　ページの最後に飛ぶ