オートフィルターで抽出したレコードがない場合のコーディング例は?

Question 007p 拙著「組み方講座・プロの定番」 Previous Next
122ページ 3章2-3 合わせ技(1) ◆ 環境・・ Excel 2003 & Windows XP
詳細は こちら
123ページの1番下に、「抽出したレコードがない場合のコーディングを追加したほうがよい」と書かれていますが、その例を教えてください。
Answer   Copyright (C) 2005.9.3 永井善王
拙著「ExcelVBAマクロ組み方講座 プロの定番・裏技・合わせ技[編]」をご購読、ありがとうございます。

3章2-3合わせ技(1)は、「リストから指定店舗分を抽出しデータ部だけを別のシートへ貼り付ける」と題するサンプルです。

その機能は右図のとおり、「売上DB」シートから '××' 店舗分のデータ(レコード)をオートフィルタで抽出し、「抜出」シートへクリップボードを経由しないでコピーします。

そして、ご質問は、このサンプルマクロの末尾にある注記についてです が、よく気付いていただけましたね。
きっと、本の最初の「はじめに」のページの下方にある下記の注も、思い出していただけたことと思います。
※2 学習で作成するマクロは紙面の制約があり、何から何まで整っているわけではありません。実際の使用に当たっては・・・

そこで、早速、サンプロマクロを試され、抽出したレコードがない場合に「抜出」シートには、「売上DB」シートの全データがコピーされてしまうことを確認し、その対応策を思案されたのでしょうね。

前置きが長くなりましたが、回答に入ります。

このすぐ前になりますが、116ページの定番(3)の[C1]に「オートフィルタで抽出したデータの行数を取得する」というサンプルがありますから、そのコーディングを挟み込んでみましょう。
Option Explicit
Dim DBシート, 基点セル, 抽出列, 抽出キー
Dim 別シート, コピー先セル
Dim コピー先シート As Worksheet
Dim 抽出範囲 As Range
Dim 領域 As Range
Dim 行数
'------------------------------------------------------------------------------
Sub リストから指定店舗分を抽出して別のシートにコピーする()
    売上DBから指定店舗分をートフィルタで抽出する
    Set 領域 = Range(基点セル).CurrentRegion
    行数 = 領域.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
    If 行数 = 0 Then
        MsgBox "一致するデータはありません"
    Else
        オートフィルタの抽出結果を別のシートへコピーする
    End If
End Sub
'------------------------------------------------------------------------------
Private Sub 売上DBから指定店舗分をートフィルタで抽出する()
    DBシート = "売上DB"
    基点セル = "A1"
    抽出列 = 1
    抽出キー = "××"
    With Worksheets(DBシート)
        .Activate
        If .AutoFilterMode Then             'オートフィルタモードがオンなら
            Selection.AutoFilter            'リセットする
        End If
    End With
    Range(基点セル).AutoFilter Field:=抽出列, Criteria1:=抽出キー
End Sub
'------------------------------------------------------------------------------
Private Sub オートフィルタの抽出結果を別のシートへコピーする()
    別シート = "抜出"
    コピー先セル = "A1"
    Set コピー先シート = Worksheets(別シート)
    Set 抽出範囲 = Worksheets(DBシート).Range(基点セル).CurrentRegion
    With 抽出範囲
        .Resize(.Rows.Count - 1).Offset(1).Copy _
        Destination:=コピー先シート.Range(コピー先セル)
    End With
End Sub
元のマクロと見比べていただくと分かるはずですが、挟み込んだカ所は上から数えて 6、7、13~15、17行目です。
その後で、24行目の
抽出キー = "××"抽出キー = "南店" というように存在しない店名に変えてから、試してみてください。
結果をご連絡いただけると嬉しいです。

 

Excel VBA Macro