• ベストアンサー

エクセルVBAでオートフィルター最上行を取得するには

データのリストからオートフィルターでE列のある特定のデータを表示し、それが複数の場合、最下行は Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row で取得できますが、見出しのすぐ下に来る一番目のデータがある最上行はどうやって取得したらいいのでしょうか? よろしくお願いします。

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

  • ベストアンサー
  • shkwta
  • ベストアンサー率52% (966/1825)
回答No.1

オートフィルタで非表示になっている行ではRowsのHiddenプロパティがTrueになっていることを利用して、 Dim 行 As Long 行 = 2 While ActiveSheet.Rows(行).Hidden   行 = 行 + 1 Wend とすると、変数「行」に先頭の行番号が入ります。

merlionXX
質問者

お礼

ありがとうございました。 出来ました。 でも、よく考えたらオートフィルターで検索してE列の一番上に来るセルの行番号ならMatchでも求められましたね。教えていただいた方法もとても勉強になりました。ありがとういございます。 Sub FirstRow() 検索値 = "XX" MsgBox Application.Match(検索値, Columns("E"), 0) End Sub

関連するQ&A

  • EXCEL VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • エクセルVBAでデータ最終行取得方法

    エクセルVBAでデータ最終行取得方法で良い方法を教えてください。 データの行数、列数は不定。 最多のデータ行の列も不定。 この条件で、データ最終行を取得するにはどうすればよいでしょうか? lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row では、A列の最終行に限定されます。 lastrow = ActiveSheet.Cells(1, "A").SpecialCells(xlLastCell).Row では、列の限定はありませんが、一旦データ入力後、削除した部分まで入ってしまいます。 lastrow = ActiveSheet.UsedRange.Rows.Count では、データ入力後、削除した部分まで入ってしまい、かつ、1行目など上部が空白の場合、不正確になります。

  • エクセルVBAにて

    エクセルのVBAにて irow=Cells(Rows.Count,1).End(xlUp).Row irowは整数型として宣言している変数です。 という記述の場合、どのような内容を表しているのでしょうか? 特に、Cells~Endの前までの記述がよく分からないのですが・・・ よろしくお願いします。

  • エクセルVBA オートフィルタの選択を元に戻す

    エクセルのVBAで、次のことはできるでしょうか。 ブックの中の3つのシートはオートフィルタが設定してあり、任意で操作し、検索に使っています。(オートフィルタを設定しないしーとが2つあります) ・別のシートにチェンジしたら、チェンジ前のシートがオートフィルタで特定の行だけを表示していたら、オートフィルタを <すべて> に戻して、消えていた行を全て表示させたいのです。(オートフィルタは次回にまた使うので、データ-フィルタ-オートフィルタでオートフィルタ自体を解除してしまうような状態にはしたくありません) ・同じく、上記のことをブックを閉じるときにも実行したいのです。 ちなみに、オートフィルタをかけてあるシートには、以下のコードがあります。 よろしくお願いします。 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) With Sheets("印刷") .Range("E15:E17").Value = _ Application.Transpose(Cells(Target.Row, 7).Resize(, 3).Value) .Range("AA16").Value = _ Cells(Target.Row, 10).Value .Range("AQ16").Value = _ Cells(Target.Row, 11).Value .Range("AX16").Value = _ Cells(Target.Row, 12).Value End With With Sheets("施設") .Range("C2").Value = _ Cells(Target.Row, 10).Value End With Cancel = True Sheets("施設").Select End Sub

  • Excelでフィルターのかかっているときの最終行の取り方。

    Dim mySh As Worksheet Set mySh = Sheet("Sheet1") Debug.Print mySh.Cells(mySh.Rows.Count,1).End(xlup).Row でデータのあるA列の最終行を取得していますが、この場合、フィルターがかかっていると実際のデータのある最終行でなくて見えている部分の最終行が返ってきます。 Excel2003 SP3 WindowsXP SP3 フィルターがかかっていても実際のデータのある最終行を取得する方法あるのでしょうか?

  • エクセルVBAで行のコピー貼り付けについて

    初心者、勉強中でエクセル2007です。 A1行からK40行までの表があります。 これを下にコピーをしながら増やしていってるのですが、マクロでしようと思い下記のとおり 考えました。 selecion.row.Offset(39, -1).Select ここでオブジェクトが必要ですと出ます。 それからその下の?とを色々ぐぐってみますがどうしてもわかりません。 それと2007ですので65536行ではないのですが、MaxRow = Cells(Rows.Count, 1).End(xlUp).Row だと動かないみたいですので下記としています。 よろしくご教授お願いします。 Sub Gcopy() MaxRow = Range("B65536").End(xlUp).Offset(-39, -1).Select データの入ってる最終行を取得 Selecion.row.Offset(39, -1).Select 選択された行から上に39行移動し選択 ?                    下へ39行まで選択   MaxRow = Range("B65536").End(xlUp).Offset(1, -1) 最終行を取得 ActiveSheet.Paste 貼り付け End Sub

  • VBAで列が可変のオートフィルの実装

    元となるSheet1のR列を「Sheet1~3」以外のシートの名前で オートフィルターさせてその内容をコピーし、数式を代入させたあと、連続データをEの列の最終セルまで 連続させてコピーするという下記のVBAを実装しました・・・が 連続データさせるEの列が1つしかなかった場合、連続データできないのでエラーが起きてしまします ですのでそれは無視してよいと単純に「On Error Resume Next」で処理しちゃってます でもこれでは、あまり良くない処理のような気がするのですが・・・ 連続データ出来ない場合は、1つのセルに数式を代入するだけでおしまい というプログラム処理はどのようにやればいいのでしょうか? ' オートフィルター For Each sh In Worksheets If sh.Name <> "Sheet1" And sh.Name <> "Sheet2" And sh.Name <> "Sheet3" Then Dim Filtarget As Range Dim Maction As Range 'コピーの開始する場所 Set Filtarget = Sheets(sh.Name).Range("A4") Set Maction = Sheets(sh.Name).Range("W4") Set Fills = Sheets(sh.Name).Range("X4") With Sheets("Sheet1").Range("R3") .AutoFilter Field:=18, Criteria1:=sh.Name .CurrentRegion.Copy With Worksheets.Add .Paste .Range("1:3").Delete .UsedRange.Copy Filtarget .Range("X1").Formula = "=E1/W1" .Range("M1:M" & Cells(Rows.Count, 13).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Maction .Range("X1").AutoFill Destination:=Range("X1:X" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeVisible) On Error Resume Next .Range("X1:X" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeVisible).NumberFormatLocal = "\#,##0;\-#,##0" .Range("X1:X" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Fills Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With .AutoFilter Field:=18 End With End If Next 以上、よろしくお願い致します。

  • エクセルVBA どうしても処理が重いのを改善したい

    下記のコードを作りましたが、どうしても処理が2分を越えてしまいます。 書き方が下手なのか。。。修正案があればぜひともご教授願います。 行っている事は。。。 1.上から順番に最後の文字が入っている所まで検索をする。 2.1の際A2とA3セル内容を取得する。(この際にA2セルに入っているドメイン取得している)この取得した値を検索元のデータとしている。 3.2にて取得したデータを元に、検索対象セルの次行から一致する値を検索する。 4.ヒットしたら、ヒットした値がある行のE列に「1」を代入 5.全ての処理が終了したら、E列に「1」がある行全て削除 6.フィルター解除 Sub 案件抽出の重複削除() Debug.Print Time & " - 案件抽出の重複削除スタート" Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim s As String '// 検索元データ Dim i As Long Dim SI As String '// 検索元データの結合データ Dim TD As String Dim SS As String Dim II As Long Dim AJS As Range '// 検索元データのステートメント Dim CAJS As Range '// 検索されるデータのステートメント On Error Resume Next For Each AJS In Range("A2:A" & Cells(100000, 1).End(xlUp).Row) s = Cells(AJS.Row, 2) i = InStrRev(s, "@") + 1 SI = Mid(s, i, Len(s) - i) & Cells(AJS.Row, 3) For Each CAJS In Range(Cells(AJS.Row + 1, 2), Cells(Rows.Count, 1).End(xlUp)) If Cells(CAJS.Row, 5) = "" Then SS = Cells(CAJS.Row, 2) II = InStrRev(SS, "@") + 1 TD = Mid(SS, II, Len(SS) - i) & Cells(CAJS.Row, 3) If SI = TD Then Cells(CAJS.Row, 5) = 1 End If TD = "" End If Next Next ActiveSheet.Range("$A$1:$E$2564").AutoFilter Field:=5, Criteria1:="1" Rows(2).Select Range(Selection, Selection.End(xlDown)).Select Selection.Delete Shift:=xlUp Selection.End(xlUp).Select ActiveSheet.AutoFilterMode = False Debug.Print Time & " - 案件抽出の重複削除終了" End Sub 宜しくお願い致します。

  • エクセルのオートフィルターがかかっていたら消すVBA

    いつもお世話になっております。 作業が終了して全てのシートを初期化する場合に、オートフィルターで抽出した状態でデータを消すと、隠れていた部分が残ってしまいます。 もし、そのシートのA1~D1までにフィルターがかかっていたら、フィルターを消す、かかっていなければ、そのままシート全体のデータを消すというマクロはどう書けばよろしいのでしょうか? -例- Sheets("ABC").Select If Range(Cells(1,1),Cells(1,4))にフィルターがかかっていたらThen  フィルターを消す  Cells.ClearContents Else Cells.ClearContents End If こんなことをしたいのですが、伝わりましたでしょうか? よろしくご指南くださいませ。

  • オートフィルター後の見出し以外をコピー

    お世話になっております。Excel2003を使ってます。 オートフィルター後の、見出し以外をコピーしようと考えています。 現在は With ThisWorkbook.Worksheets("テスト") .Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select '可視セルの選択 Selection.Copy '可視セルコピー ThisWorkbook.Worksheets("フィルタ用").Range("A" & m).PasteSpecial 'A列に貼り付け! Excel.Application.CutCopyMode = False 'クリップボードの内容クリア End with この内容で上手くいっていましたが、 見出し+1行しかない場合、 全範囲選択になってしまい、上手くいかない状況です。 どうやったら、見出し以外のB列をコピーできるのでしょうか? Offset とか、 Resize を使えばいけるのでしょうか…? 見出し以外の行、 B列、C列、D列 F列 を 「TEST」シートにコピーしたいです。 With ThisWorkbook.Worksheets("テスト").Range("A1").CurrentRegion .Offset(1, 1).Resize(.Rows.Count - 1, 3).Copy _ Destination:=Thisworkbook.worksheets("TEST").Range("A" & m) .Offset(1, 4).Resize(.Rows.Count - 1, 1).Copy _ Destination:=Thisworkbook.worksheets("TEST").Range("D" & m) End With 考えたのですが、良く分からなくなってしまいました。 回答をお願い致します!

専門家に質問してみよう