| |
▼くまけん さん：
>その”名前”の数万行には例えば、「森田一義」や「四角株式会社」、
>「日本寺」などがあるため、”株式会社”や”寺”で検索を行って、
>そのヒットした部分の「Sheet1の行」を削除し、
>その行をSheet2に上から順に貼り付けていきたいのです。
行削除の件ですが、
フィルタされた可視行だけをCutして別シートに移動しようとしても、
表全体がCutされてしまうので、
可視行を別シートにCopyしておいてから、可視行をDeleteする
という方法を用います。
フィルタをかける表のあるシート Worksheets(1)
コピー先シート Worksheets(2)
としますと、
Sub Test2b()
Dim CopyTo As Range
Dim StrInput As String
StrInput = InputBox("抽出文字列")
If StrPtr(StrInput) = 0& Then Exit Sub
StrInput = "*" & StrInput & "*"
Set CopyTo = Worksheets(2).Range("A65536").End(xlUp).Offset(1) 'コピー先
With Worksheets(1).Range("A1").CurrentRegion 'フィルタ範囲
.AutoFilter 1, StrInput 'A列にフィルタをかける
With Intersect(.Cells, .Offset(1)) '見出し行を除く抽出データ
.Copy CopyTo '別シートにコピー
.Columns(1).EntireRow.Delete '抽出行を削除
End With
.AutoFilter
End With
End Sub
|
|
kanabun
- 09/9/17(木) 13:59 -
