AutoFilterについてのコードの問題

前へ 次へ
このQ&Aのポイント
  • 質問者は、AutoFilterを使用してデータを抽出し、件数をカウントするVBAコードを作成しましたが、一部の値が正しく表示されない問題が発生しました。
  • 質問者が作成したVBAコードは、指定した条件でデータを抽出し、表示されたデータの件数を数える機能がありますが、一部の条件において正しく動作していないようです。
  • 質問者が作成したVBAコードは、特定の条件に基づいてデータを抽出し、別のシートに表示されたデータの件数を表示しますが、一部の場合において正確な結果が表示されない問題が発生します。
回答を見る
  • ベストアンサー

AutoFilterについて

AutoFilterについて、下記のコードを作成しました。 シート：部品表のE列：testで抽出 → オートフィルタで抽出された件数を シート：部品数抽出のセル(2,6)に表示→ シート：部品表のE列：test1で抽出→ シート：部品数抽出のセル(4,6)に 表示するようにしましたが、 セル(2,6)の値が表示されてしまいます。 コードのどこに問題があるでしょうか。 Sub 部品数抽出オートフィルタ() Dim r As Long 　'最終行用 Dim r1 As Long　 '表示されているデータの最終行を取得 Dim countdata As Long 　'データ数カウント用 '●[E列 モデル名:test] '最終行を取得 r = Cells(Rows.Count, 1).End(xlUp).Row 'E列が[test]のものを抽出 Range("A1").AutoFilter Field:=5, Criteria1:="test" '表示されているデータの最終行を取得 r1 = Range("A1").SpecialCells(xlCellTypeLastCell).Row '実行時エラー:1004(該当するデータがありません)が出た場合に ’この行より下ではエラーを無視する On Error Resume Next If r1 = 1 Then countdata = 0 Else 　'表示されているデータ数を取得 countdata = Range(Cells(2, 1), Cells (r, 1)).SpecialCells(xlCellTypeVisible).Count End If 'オートフィルタで抽出された件数を別のシートのセルに表示 Sheets("部品数抽出").Cells(2, 6).Value = countdata 'この行より下ではエラー無視が解除される On Error GoTo 0 '絞り込み結果のみクリア ActiveSheet.ShowAllData '●[E列 モデル名:test1] r = Cells(Rows.Count, 1).End(xlUp).Row Range("A1").AutoFilter Field:=5, Criteria1:="test3" On Error Resume Next r1 = Range("A1").SpecialCells(xlCellTypeLastCell).Row If r1 = 1 Then countdata = 0 Else countdata = Range(Cells(2, 1), Cells(r, 1)).SpecialCells(xlCellTypeVisible).Count End If Sheets("部品数抽出").Cells(4, 6).Value = countdata On Error GoTo 0 ActiveSheet.ShowAllData End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.4

あと If r1 = 1 Then countdata = 0 Else countdata = Range(Cells(2, 1), Cells(r, 1)).SpecialCells(xlCellTypeVisible).Count End If を countdata = 0 If r1 <> 1 Then countdata = Range(Cells(2, 1), Cells(r1, 1)).SpecialCells(xlCellTypeVisible).Count End If にするとかもありだと思います。

Japan20121012
質問者

お礼

問題を解決することができました。 有り難う御座います。

その他の回答 (4)

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.5

それと On Error Resume Next を、いったん外してみたらいかがでしょう

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.3

> test3は該当するデータがない結果です。 実行してみましたがセル(4,6)は0になりますよ。 r1もA列だったのですね r1 = Range("A1").SpecialCells(xlCellTypeLastCell).Row を r1 = Range("E1").SpecialCells(xlCellTypeLastCell).Row にしてみるとか ActiveSheet.ShowAllData をブレークポイントにして実際のフィルターされた状態を確認してみるとかしてみてはいかがですか。

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.2

あと A列の最後とE列の最後が同じでなければ countdata = Range(Cells(2, 1), Cells(r, 1)).SpecialCells(xlCellTypeVisible).Count の Cells(r, 1) は Cells(r1, 1) じゃないでしょうか。

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.1

> test1で抽出 コードは > Range("A1").AutoFilter Field:=5, Criteria1:="test3" testとtest3が同じ数だけあったということではないのですか。

Japan20121012
質問者

お礼

説明が不足していて申し訳ありません。 test3は該当するデータがない結果です。 セル(4,6)に0が表示されればよいのですが セル(2,6)の値が表示されてしまいます。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • range表記をcells表記にしたい

    B列の最終行までループさせたいのですが Sub Sample() Dim col As Long col = 2 For Each R In Range("B1:B" & Cells(Rows.count, "B").End(xlUp).Row) Next End Sub この状態から、Bを使わずに、 col = 2を使って、書き換えてもらっても良いですか？ For Each R In Range(Cells(1, col), Cells((Rows.count, col)).End(xlUp).Row) これにするとエラーになります。

  • VBA 最終列に入力された値の表示について

    VBAで最終列に入力された値の表示について教えてください。 例えば10行目の10列目(J列)に”123”と入力された値をセル”D1”に表示させたいのですがどのようにすればよいのでしょうか。 A列の最終行については Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long r = Cells(Rows.Count, 1).End(xlUp).Row Range("D1").Value = Cells(r, 1).Value End Sub でうまく表示できたのですが、最終列についてなかなかうまくいきません。 どなたかご指南ください宜しくお願いします。

  • 最終列に入力されている文字を表示する

    エクセルVBAで最終列に入力されている値の表示方法について教えてください。 最終行については表示できるのですが、最終列に入力されているものの表示がうまくいきません。 A列の最終行の値をセル”D1”に表示するについては Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long r = Cells(Rows.Count, 1).End(xlUp).Row Range("D1").Value = Cells(r, 1).Value End Sub でうまくいきました。 最終行、例えば3列目の10行目に”111”と入力されているときにセル”D1”に”111”と表示するようにはどうしたらよいのでしょうか。 どなたがご指南ください宜しくお願いします。

  • 文字列を分割して、分割した文字の一番右側を表示するにはどうしたら良いのでしょうか？

    Sub test2() Dim moji() As String Dim a As Range Dim 行 As Long For 行 = 2 To Cells(Rows.Count, 1).End(xlUp).Row Set a = Cells(行, 1) moji() = Split(a, "-") On Error GoTo moji Cells(行, 2) = moji(3) Next 行 moji: Cells(行, 2) = moji(2) End Sub で A列 B列 1-2-3-4 4 10-11-11-12 12 1-2-3-10 10 1-2-10-3 3 1-2-3 3 1-2 1-13 11-14 11-3 の結果になりますが1-2,11-14,11-3の部分が表示できません。 どなたかよいほうほうをお願いします。

  • 実行時エラー1004空白セルを上に詰める

    よろしくお願いします いろいろ試しましたが解決できませんでした。 Private Sub CommandButton1_Click() With Worksheets("Sheet1") For r = 2 To .Cells(Rows.Count, "C").End(xlUp).Row If .Cells(r, "C").Value = 提出先.Value Then Me.提出先.Value = "" .Cells(r, "C").Value = "" Else End If Next r .Range("J3").Value = "" ’下記の構文でエラーが出ます ’実行時エラー1004 ’アプリケーション定義またはオブジェクト定義のエラーです .Range(Range("C2"), Cells.SpecialCells(xlCellTypeLastCell)).SpecialCells (xlCellTypeBlanks).Delete Shift:=xlUp End With End Sub

  • オートフィルタ　最終行を指定する必要は？

    エクセルでＶＢＡでオートフィルタをする場合、 ******************************************* Sub test1() 最終列 = Range("IV1").End(xlToLeft).Column Range(Cells(1, 1), Cells(1, 最終列)).AutoFilter End Sub Sub test2() 最終行 = Range("a65536").End(xlUp).Row 最終列 = Range("IV1").End(xlToLeft).Column Range(Cells(1, 1), Cells(最終行, 最終列)).AutoFilter End Sub ******************************************* どちらでもできるのですが、 test2のように最終行を取得・指定する必要はあるのでしょうか？

  • VBAのSUBPRODUCT関数の引数について

    ＶＢＡに詳しい方へ 　部品単価積み上げなどで　部品単価×分子員数／分母員数の合計を計算するときにSUBPRODUCT関数を使いますがマクロ記録すると Range("D3").Select ActiveCell.FormulaR1C1 = "=SUMPRODUCT(R5C2:R9C2,1/R5C3:R9C3,R5C4:R9C4)" となります。 　2列に員数分子　3列に員数分母、4列に部品単価が　5行から下に部品ごとに記入されています。 D3セルに　関数として入力されます。 これでは　部品の追加に対処できないので　セルを変数にして表現したいのです。 これと同じことを　ＶＢＡで行数可変に対応すると　分母員数の逆数を受け付けず 実行時エラー13：型が一致しない　と表示されます。 　 Option Explicit Dim 分子群 As Range Dim 分母群 As Range Dim 単価群 As Range Sub Macro1() ' Range("D3").Select ActiveCell.FormulaR1C1 = "=SUMPRODUCT(R5C2:R9C2,1/R5C3:R9C3,R5C4:R9C4)" '---(1)　計算可能だが動的に対処不可能 End Sub Sub Macro2() Range("D3").Select Set 分子群 = Range(Cells(5, 2), Cells(Cells(5, 2).End(xlDown).Row, 2)) Set 分母群 = Range(Cells(5, 3), Cells(Cells(5, 3).End(xlDown).Row, 3)) Set 単価群 = Range(Cells(5, 4), Cells(Cells(5, 4).End(xlDown).Row, 4)) ActiveCell = Application.SumProduct(分子群, 分母群, 単価群) '---(2)　エラー発生なし ActiveCell = Application.SumProduct(分子群, 1 / 分母群, 単価群) '---(3)　エラー発生　(1)と同じ表現（分母）にできない。 End Sub これ以上のセル列は使わず、簡潔にD3セルへ入力するにはどうすればよろしいでしょうか？ 結果数値だけでなく、関数が入力されるのが希望です。 基本的知識が乏しく、恐縮ですが　よろしくご回答をお待ちしております。------以上

  • VBAでオートフィルタの可視セルクリア後空白行削除がうまくできません

    VBA初心者です。 オートフィルターで抽出した行を削除したくて、以下のように書いたのですが、最後の一文でエラーになってしまいます。 ◆エラー内容◆ 実行時エラー1004 重複する選択範囲に対してそのコマンドを使用することはできません。 ◆書いたVBA◆ 　　Range("A2").Select Selection.AutoFilter Field:=1, Criteria1:="=1111", Operator:=xlAnd 'オートフィルターで「1111」を抽出 Dim r As Range Set r = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible) r.ClearContents 'A列の可視セルの値をクリア Range("A2").Select Selection.AutoFilter 'オートフィルターの解除 r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'A列が空白の行は削除→　ココがエラーになります --------------------------------------------------------- 元のファイル構成は2行目に項目名で、3行目からデータが入っています。 いろいろ調べたのですが、よくわからなかったので教えていただければ 幸いです。 宜しくお願いします。

  • VBA sumifで計算できません

    集計シートに入力シートから抽出した重複しない検索データの合計値を入力シートでSUMIFで書いてみましたが　 「オブジェクトはこのプロパティまたはメソッドをサポートしていません。」とエラーになります。 何がいけないのか調べてみましたがVBA初心者でわからず困っています。 教えてください。よろしくお願いします。 Dim 集計データ数 As Long Dim 入力シートデータ数 As Long Dim データ行 As Long 集計データ数 = Cells(Rows.Count, 38).End(xlUp).Row 入力シートデータ数 = Worksheets("入力").Cells(Rows.Count,29).End(xlUp).Row For データ行 = 11 To 集計データ数 Cells(データ行, 11).Value = Application.WorksheetFunction.SumIf(Worksheets("入力").Range(Cells(11, 29), Cells(入力シートデータ数, 29)),Cells(データ行, 2), Worksheets("入力").Range(Cells(11, 21), Cells(データ行, 21))) Next データ行 End Sub

  • VBAで教えてください。

    以前ここで教えていただいたＶＢＡで http://jisaku.155cm.com/src/1371930716_9b9006528605642980beed48a8998013b0731e4b.jpg のようにＡ列のテスト４をクリックしたときにＣ列のテスト４が一発で解るようにしたいです。 もちろん、テスト１１をクリックしたときは、テスト４塗りつぶしは解除され、 テスト１１が塗りつぶされるようにしたいです。 写真は塗りつぶししていますが、解るようにしたいだけなので、塗りつぶしにはこだわっていません。 あと、Ｅ、Ｆ、Ｇ列は解りやすく並べているだけで、実際はＡ、Ｂ、Ｃ列だけです。 それと、Ｃ列は関数を使って表示してあります。 という質問で Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("C:C").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("A:A")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "C") = Target Then Cells(i, "C").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで をシートのコードに張り付ければいいですよ。と教えてくれたものがあるのですが、 Ａ列でクリックした文字をＣ列からすべて見つけて反転してくれないようです。何個か反転してくれない ものが出てきてしまいました。 Ｃ列が何百行とかなってしまうと、すべての同じ文字を検索してくれないのでしょうか？ ちなみに列がここに掲載しているものと違うので Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("R:R").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("B:B")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "R") = Target Then Cells(i, "R").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで のＣをＲにＡをＢに変更して使ってます。 これがいけないのかな？ よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する