Excelの質問です。A列から2つのキーワードを含むセルを行毎、別シートに移動させたいです。


今、Sheet1のA列からZ列に、6万行ほどのデータがあります。
最初に、A列で“りんご”というキーワードを含むセルを検索しまして。
該当するセルが、例えば1200セルあったとしましたら。
そのセルを含む行まるごと、1200行をSheet2に移動させます。

次に“ごりら”というキーワードで、同じくA列を検索しまして。
該当するセルが、例えば500セルあったとしましたら。
そのセルを含む行まるごと、500行を、最初に移動させた1200行の真下(1201行目)に、加えます。

そのような作業をマクロなどで実現できないでしょうか。
よろしくお願い致します。

回答の条件
  • 1人10回まで
  • 登録:2017/11/11 22:54:15
  • 終了:2017/11/30 22:54:16

回答(2件)

id:hathi No.1

hathi回答回数208ベストアンサー獲得回数462017/11/12 19:25:07

このようなのでも、加工すると、使えるかもしれません。


Sub Macrowawa()
wawa = Sheets("Sheet1").Range("$A$15").CurrentRegion.Address
Stop  ' wawaは適当 A15は適当(データのある行)
Sheets("Sheet1").Range(wawa).AutoFilter Field:=1, Criteria1:="hgYY4.3"
Stop  ' hgYY4.3は、「りんご」「まぐろ」などの抽出するもの 
Sheets("Sheet1").Range(wawa).CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A2")
Stop  ' A2は、貼り付ける先の左上端
Sheets("Sheet1").Range(wawa).AutoFilter Field:=1
End Sub

id:moon-fondu

ご回答ありがとうございます。
うーん、

Sub Macrowawa()
wawa = Sheets("Sheet1").Range("A1:60000").CurrentRegion.Address
Stop ' wawaは適当 A15は適当(データのある行)
Sheets("Sheet1").Range("A1:A60000").AutoFilter Field:=1, Criteria1:="りんご"
Stop ' hgYY4.3は、「りんご」「まぐろ」などの抽出するもの
Sheets("Sheet1").Range("A1;60000").CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A2")
Stop ' A2は、貼り付ける先の左上端
Sheets("Sheet1").Range("A1;60000").AutoFilter Field:=1
End Sub

にしてみたのですが・・・2行目でオブジェクトの定義エラーになってしまいました。

2017/11/17 23:53:35
id:hathi

例えば次のように直して実行してみてください。
wawa = Sheets("Sheet1").Range("A1:60000").CurrentRegion.Address

wawa = Sheets("Sheet1").Range("A1:A60000").CurrentRegion.Address

Sheets("Sheet1").Range("A1;60000").CurrentRegion.Copy Destination:=Sheets("Sheet2")

Sheets("Sheet1").Range("A1:A60000").CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A2")

Sheets("Sheet1").Range("A1;60000").AutoFilter Field:=1

Sheets("Sheet1").Range("A1:A60000").AutoFilter Field:=1

なお、Stop とかいてある行は、行そのものがないのが普通のやり方です。
例でStopの行があるのは、その直前の動作でシートがどのようになったのかを目で確認するためだけです。
「;」と「:」とでは違います。 アドレスの表記方法は決まったやり方をする必要があります。

また、仮に60000行まである場合でも、1234行までの場合でも、このような連続した範囲を対象にして動作させるためであれば、「.CurrentRegion」の指定で十分です。 

また、
wawa = Sheets("Sheet1").Range("A1").CurrentRegion.Address
と書くことで、この行を実行したときに、
「wawa」は、A1を含む何かの記入がなされてる連続したすべての範囲になります。 例えば、wawaは、$A$1:$M$63265 というアドレスを記憶します。
そうなので、次のコードでも、結果は同じです。

Sub Macrowawar0()
wawa = Sheets("Sheet1").Range("A1").CurrentRegion.Address
Sheets("Sheet1").Range(wawa).AutoFilter Field:=1, Criteria1:="りんご"
Sheets("Sheet1").Range(wawa).CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A2")
Sheets("Sheet1").Range(wawa).AutoFilter Field:=1
End Sub

もちろん wawaなどいい加減な名前を使うのではなく、myAreaのようにした方が、格好がましになります。

これでも、結果は同じです。

Sub SampleX()
Sheets("Sheet1").Range("A1").AutoFilter Field:=1, Criteria1:="りんご"
Sheets("Sheet1").Range("A1").CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A2")
Sheets("Sheet1").Range("A1").AutoFilter Field:=1
End Sub

2017/11/18 16:18:16
id:ardarim No.2

ardarim回答回数896ベストアンサー獲得回数1442017/11/17 01:36:04

サンプルマクロです。
ExtractRowsで実行します。

Const Keyword1 As String = "りんご"
Const Keyword2 As String = "ごりら"

Sub ExtractRows()

    Dim r As Long

    ' シート1の書式をコピー
    Worksheets("Sheet1").Columns("A:Z").Copy
    With Worksheets("Sheet2")
        .Columns("A:Z").Select
        .Paste
        .Cells.Clear
    End With
    
    ' キーワードに一致する行をシート2へ移動
    r = 1
    Application.ScreenUpdating = False
    Call ExtractKeyword(Keyword1, r)
    Call ExtractKeyword(Keyword2, r)
    Application.ScreenUpdating = True

End Sub

Sub ExtractKeyword(ByVal Keyword As String, ByRef DstRow As Long)

    Dim r As Long
    Dim src As Worksheet, dst As Worksheet
    
    Set src = Worksheets("Sheet1")
    Set dst = Worksheets("Sheet2")
    
    For r = 1 To src.Cells.SpecialCells(xlCellTypeLastCell).Row
        If src.Cells(r, 1).Value = Keyword Then
            src.Rows(r).Cut
            dst.Rows(DstRow).Select
            dst.Paste
            DstRow = DstRow + 1
            src.Rows(r).Delete
            r = r - 1
        End If
    Next r

    Set dst = Nothing
    Set src = Nothing

End Sub
id:moon-fondu

ありがとうございます。
ですがすみません、

実行時エラー“1004”
RangeクラスのSelectメソッドが失敗しました。

というダイアログが出てきてしまい、「.Columns("A:Z").Select」のところでマクロが止まってしまいます…。

2017/11/17 23:56:16
id:ardarim

Selectの際にシートがアクティブになっていないとエラーになることがあるようです。
With Worksheets("Sheet2")
の次の行に
.Activate
を入れてみていただけますでしょうか。

2017/11/18 14:34:01

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません