別シートに表示した項目の行以外を非表示とする

VBAを始めたばかりの全くの素人です。コードの書き方が分からないのでご指導願います。

Sheet1に品名と値段が記載されている。※データ数は5000～10000位で可変します。
Sheet2に対象の品名が記載されている。※表示したいデータを数十点記載します。（変動）
Sheet2に記載されている品名以外のSheet1の行を非表示にするVBAコードを教えて下さい。
　※ｽｲｶ、栗、ｻｸﾗﾝﾎﾞ、メロン、梨、柿以外を非表示にする。（品名、数量は変動します。）

No.3 ベストアンサー 回答者： tom04 回答日時： 2015/06/27 10:09

No.2です。

＞私の今後の勉強の為に、Dim i As Long, wS As Worksheetや Dim str As String, buf As String, myAryなどの変数の部分を含め、各コードの説明書きをしていただけたら、とても助かります。

一つ一つ説明するとコードより説明文の方が長くなりそうなのですが、
とりあえず前回のコードにコメントを入れてみました。

Sub Sample1()
'変数の宣言//
Dim i As Long '「i」は整数を格納できる「長整数型」で宣言//
Dim wS As Worksheet '「wS」はワークシートオブジェクトを格納できる「ワークシート型」で宣言//
Dim str As String, buf As String '「str」と「buf」は文字列を格納できる「String」型で宣言
'↑同行に記載する際も一つ一つ丁寧に宣言する（str,buf as String　とすると「str」はVariant型になってしまう）//
Dim myAry '何も宣言していないので「myAry」はVariant型として宣言
'↑　Dim myAry As Variant　の方が丁寧です。//

Set wS = Worksheets("Sheet2") '「Sheet2」を変数「wS」に格納//
With Worksheets("Sheet1") '「With」は今後いちいち　Worksheets("Sheet1").・・・・と記載するためを省くため//
For i = 2 To wS.Cells(Rows.Count, "B").End(xlUp).Row '2行目～「wS」のB列最終行までループ//
str = str & wS.Cells(i, "B") & "," '「wS」i行B列セルと「,」を変数「str」に順次格納//
Next i
'「str」は　スイカ,栗,サクランボ,メロン,梨,柿, となっている（最後にカンマがつく）//
buf = Left(str, Len(str) - 1) 'strの最後のカンマを除いた文字列を「buf」に格納//
myAry = Array(Split(buf, ",")) '「buf」をカンマで区切った文字列一つ一つをmyAryに格納//
'▼　「wS」のB列でmyAryに格納されているものだけでフィルタを掛ける//
.Range("A1").AutoFilter field:=2, Criteria1:=myAry, Operator:=xlFilterValues
End With '「With」を終える
End Sub

※　説明としては不完全な部分もあるかと思いますので、
各詳細はネットで検索してみてください。
いくらでもヒットするはずです。

※　最後の
＞・・・Operator:=xlFilterValues
はExcel2007以降で使用可能です。（画像を拝見するとExcel2013のようなので）

まずはこの程度で・・・m(_ _)m

No.5 回答者： hallo-2007 回答日時： 2015/06/28 17:58

No,4です。

ついでに、こちらの方が使いやすそうなので
Sheet2に
　A　B　C　　D　　E　　F
　　品名　　日付　品名　値段
とD,E,Fの一行目に、必要な項目をコピーしておきます。
Sheet2の名前のタブを右クリック
コードの表示をクリック
VBエディターが開いたら
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Sheets("Sheet1").Columns("A:C").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B" & Range("B1").End(xlDown).Row), _
CopyToRange:=Range("D1:F1"), _
Unique:=False
End If
End Sub

張り付けて閉じる
Sheet2のB2以下に　品名を追加、変更すれば瞬時にその条件の一覧が表示されます。

この回答へのお礼

何度もご回答して頂き、ありがとうございます。
私の勉強に役立てさせて頂きます。

お礼日時：2015/06/29 18:53

No.4 回答者： hallo-2007 回答日時： 2015/06/28 13:52

アドバンスフィルターの機能を使って

Sheet1から実行すものとして

Sub Macro1()
Columns("A:C").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Sheets("Sheet2").Range("B1:B" & Sheets("Sheet2").Range("B1").End(xlDown).Row), _
Unique:=False
End Sub
全てを表示（元に戻す）
Sub Macro2()
Columns("A:C").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Sheets("Sheet2").Range("B1:B" & Sheets("Sheet2").Range("B1").End(xlDown).Row+1), _
Unique:=False
End Sub

アドバンスフィルター（フィルターオプション）については
http://www.eurus.dti.ne.jp/yoneyama/Excel/filter …
で紹介されています。

この回答へのお礼

ご回答ありがとうございました。
うまく動きました。

お礼日時：2015/06/28 16:58

No.2 回答者： tom04 回答日時： 2015/06/26 19:16

こんばんは！

すでに回答は出ていて、ほとんどNo.1さんと同じ内容になりますが・・・
標準モジュールです。

Sub Sample1()
Dim i As Long, wS As Worksheet
Dim str As String, buf As String, myAry
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
For i = 2 To wS.Cells(Rows.Count, "B").End(xlUp).Row
str = str & wS.Cells(i, "B") & ","
Next i
buf = Left(str, Len(str) - 1)
myAry = Array(Split(buf, ","))
.Range("A1").AutoFilter field:=2, Criteria1:=myAry, Operator:=xlFilterValues
End With
End Sub

こんな感じでも大丈夫だと思います。m(_ _)m

この回答へのお礼

ご回答ありがとうございました。
ご希望通り動きました。　
まだＶＢＡを始めたばかりで良くわからない部分があります。私の今後の勉強の為に、Dim i As Long, wS As Worksheetや Dim str As String, buf As String, myAryなどの変数の部分を含め、各コードの説明書きをしていただけたら、とても助かります。
宜しくお願い致します。

お礼日時：2015/06/27 09:30

No.1 回答者： x-1919 回答日時： 2015/06/26 17:34

対象のデータ リストが "SheetA" という名前で、1行目がタイトル行。

A1 から縦も横も途切れなくデータが入っている。

フィルターの候補リストが "SheetB" という名前で、B列に入っている。
1行目がタイトルで、2行目から下に向かって途切れなくデータが入っている。

という、質問にあるまんまの条件で。
※ 下記コードの行頭が空白文字で字下げされているのは全角空白です。
※ コピペする場合は注意してください。

' フィルターを掛ける条件リストを配列で作成する
Dim listSheet As Worksheet
Dim listRange As Range
Dim listArray() AS Variant

' 質問文にならって Sheet2 の B列にリストがあり、なおかつ 1行目は不要なタイトル セルであるとと仮定
Set listSheet = ThisWorkbook.Worksheets("Sheet2")
Set listRange = listSheet.Range("B1").CurrentRegion.Offset(1, 0).Resize _
　　　　　　　　　　　(listSheet.Range("B1").CurrentRegion.Rows.Count - 1, listSheet.Range("B1").CurrentRegion.Columns.Count)

' 一次元配列にリストを格納
ReDim listArray(listRange.Rows.Count -1)
Dim i As Long
For i = 0 To listRange.Rows.Count -1
　　listArray(i) = listRange(i + 1, 1).Value
Next

' オートフィルター対象範囲
Dim targetSheet As Worksheet
Dim targetRange As Range
Set targetSheet = ThisWorkbook.Worksheets("SheetA")
Set targetRange = targetSheet.Range("A1").CurrentRegion

' オートフィルターを掛ける
targetRange.AutoFilter Field:=2, Criteria1:=listArray, Operator:=xlFilterValues

この回答へのお礼

希望通り動きました。
ご回答ありがとうございました。

お礼日時：2015/06/27 09:22