エクセル VBA 特定の文字列

質問

エクセル VBA 特定の文字列
A列に、様々な文字列があるとします。
そのうち、りんごと書かれている行のみを別シートに書き出すマクロを教えてください。

お願い致します。

回答No.4

K Kazz（@JazzCorp） · ベストアンサー

Option Explicit
Sub BigAppleInNY()
Dim xSheet As Worksheet
Dim xLast As Long
Dim kk As Long
Dim nn As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Sheet2")
.UsedRange.clear
End With
Set xSheet = Sheets("Sheet1")
'xLast = xSheet.UsedRange.Rows.Count
xLast = xSheet.Cells(Rows.Count, "A").End(xlUp).Row
kk = 1
For nn = 1 To xLast
If InStr(xSheet.Cells(nn, "A").Value, "りんご") > 0 Then
With Sheets("Sheet2")
'.Cells(kk, "A").Value = xSheet.Cells(nn, "A").Value xlpastevalues
Application.CutCopyMode = False
xSheet.Rows(nn).Copy
.Rows(kk).PasteSpecial
Application.CutCopyMode = True
kk = kk + 1
End With
End If
Next nn
Sheets("Sheet2").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

回答No.3

hallo-2007

＞りんごと書かれている行のみを別シートに書き出す
エクセルにはフィルターオプションという機能があります。
http://www.eurus.dti.ne.jp/yoneyama/Excel/filter3.htm
でも参考してみてください。
マクロのコードについても最後のほうに説明されています。

回答No.2

keithin

こんばんは。

ごく一般には、オートフィルタを使うのが一番簡単で高速です。

sub macro1()
range("A:A").autofilter field:=1, criteria1:="リンゴ"
activesheet.autofilter.range.entirerow.copy worksheets("Sheet2").range("A1")
activesheet.autofiltermode = false
end sub

ただし。
＞A列に、様々な文字列があるとします

こういった漠然としたご相談の状況では、リスクもあります。
一番問題になるのが、あなたのリストが
「１行目にタイトル行、２行目からデータ」といった標準的なリスト形式になっているのか、
それともいきなり１行目からだらっとデータが並んでいる状況のお話をしているのか、
という点です。

前者の場合、タイトル行をコピーしたいのかしたくないのか、という問題もあります。
また後者の場合ですと、言わずもがなですが先頭データが「りんご」ではない場合、間違った処理になります。

また既出回答でも指摘されていますが「りんごを抽出したい」のか、「りんごを含む行を抽出したい」のか、によっても具体的なマクロは変わってきます。

もうひとつ、「リンゴ（を含んだ）セル」をコピーしたいのか、「リンゴの行」をコピーしたいのか、目に見えるエクセルの様子としてどこのセル範囲をコピーしたいのかも曖昧です。

回答No.1

tom04

こんばんは！
一例です。

Sheet1のデータをSheet2にコピー＆ペーストするようにしてみました。
標準モジュールに↓のコードをコピー＆ペーストしてマクロを実行してみてください。
1行目は項目行で最終列までデータが入っているとします。

Sub test()
Dim i As Long
Dim j As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

ws1.Cells(1, 1).CurrentRegion.AutoFilter field:=1, Criteria1:="*りんご*"
i = ws1.Cells(Rows.Count, 1).End(xlUp).Row
j = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Range(ws1.Cells(1, 1), ws1.Cells(i, j)).Copy ws2.Cells(1, 1)
ws1.AutoFilterMode = False
End Sub

※　「りんご」を含むでオートフィルタをかけています。
もし「りんご」限定であれば　コード内の　*りんご* のアスタリクスを削除してください。

こんなんではどうでしょうか？m(_ _)m