Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Excel 2016)
オートフィルターで結果が0の場合は表示しない
投稿日時: 19/06/03 13:15:57
投稿者: vaioyuki

お世話になっております。
またまた質問です。
 
Sub macro1()
 
Sheets("貼付_料金レポ").Select
Range("a2").Select
 
    With Range("A2")
        .AutoFilter 30, ">6000"
        Worksheets("貼付_料金レポ").Range(Range("A3"), Cells(Rows.Count, 36).End(xlUp)).Copy Worksheets("通話料6,000円超過").Range("a3")
        .AutoFilter
        .AutoFilter 18, ">1536"
        Worksheets("貼付_料金レポ").Range(Range("A3"), Cells(Rows.Count, 36).End(xlUp)).Copy Worksheets("通信料1,536円超過").Range("a3")
        .AutoFilter
    End With
     
    With Range("A2")
    End With
 
 
End Sub
 
 
マクロのボタンを置く用のシートを使って作業しようと思っています。
1行目には結合されたセルの大項目、
2行目にはオートフィルターを設定する小項目があります。
それぞれの結果を別シートに貼付するようにしていますが、
オートフィルターの結果が0の場合、小項目がコピーされてしまいます。
オートフィルターの結果が0の場合はコピーしないような設定はできますか?
 
よろしくお願いします。

回答
投稿日時: 19/06/03 16:26:31
投稿者: WinArrow
投稿者のウェブサイトに移動

オートフィルタ実行後
対象セル範囲の行数で判定する方法があります。
 
行数=1は、項目行のみなので、検索されたデータは0件ということになります。

回答
投稿日時: 19/06/03 23:25:37
投稿者: WinArrow
投稿者のウェブサイトに移動

サンプルコード
 
@複写元セルの先頭セルをA2にしています。
A複写元セル範囲を「CurrentRegion」にしています。
B各シートをオブジェクト変数にして、コードを見やすくしています。
CSELECTしなくても実行可能です。
 
 
 
 
Sub macro1()
Dim Shtレポ As Worksheet
Dim sht6000 As Worksheet, sht1536 As Worksheet
 
    Set Shtレポ = Worksheets("貼付_料金レポ")
    Set sht6000 = Worksheets("通話料6,000円超過")
    Set sht1536 = Worksheets("通話料1,536円超過")
     
    With Shtレポ
        .Range("A2").AutoFilter 30, ">6000"
        With .Range("A2").CurrentRegion
            If .Rows.Count > 1 Then
                .Copy Destination:=sht6000.Range("A3")
            End If
        End With
        .Range("A2").AutoFilter
        .Range("A2").AutoFilter 18, ">1536"
        With .Range("A2").CurrentRegion
            If .Rows.Count > 1 Then
                .Copy Destination:=sht1536.Range("A3")
            End If
        End With
        .Range("A2").AutoFilter
    End With
End Sub

回答
投稿日時: 19/06/04 11:13:10
投稿者: WinArrow
投稿者のウェブサイトに移動

1行目のセルが空白以外のデータがあると
AutoFilterの▼が1行目に設定されてしまいますね
 
無理やり2行目に空白行を挿入し、
3行目をオートフィルタ設定する行とします。
処理の最後に挿入した2行目を削除します。
 
修正したサンプルコード
 
Sub macro1()
Dim Shtレポ As Worksheet
Dim sht6000 As Worksheet, sht1536 As Worksheet
Dim StartCell As Range
 
    Set Shtレポ = Worksheets("貼付_料金レポ")
    Set sht6000 = Worksheets("通話料6,000円超過")
    Set sht1536 = Worksheets("通話料1,536円超過")
      
    With Shtレポ
        .Rows(2).Insert shift:=xlDown
        Set StartCell = .Range("A2").Offset(1)
        StartCell.AutoFilter 30, ">6000"
        With StartCell.CurrentRegion
            If .Rows.Count > 1 Then
                .Copy Destination:=sht6000.Range("A3")
            End If
        End With
        StartCell.AutoFilter
        StartCell.AutoFilter 18, ">1536"
        With StartCell.CurrentRegion
            If .Rows.Count > 1 Then
                .Copy Destination:=sht1536.Range("A3")
            End If
        End With
        StartCell.AutoFilter
        .Rows(2).Delete
        Set StartCell = Nothing
    End With
End Sub

投稿日時: 19/06/04 16:10:11
投稿者: vaioyuki

ありがとうございます。
思った通りのものが出来上がりました。
 
CurrentRegionがすべてのセルを選択してしまうと思っていたので勉強になりました。