[[20210804112117]] 『フィルター後の行番号を取得したい』(おきた) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『フィルター後の行番号を取得したい』(おきた)

分からない事がありましたので質問させて頂きます。

 Sub Sample5()

 Dim MaxRow  As Long
 Dim Count  As Long
 Dim i  As Long
 Dim j  As Long

 MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

 With Range(Cells(2, 1), Cells(MaxRow, 37))

    .AutoFilter Field:=1, Criteria1:="3"
    .AutoFilter Field:=2, Criteria1:="5"
    .AutoFilter Field:=3, Criteria1:="6"
    .AutoFilter Field:=4, Criteria1:="30"
    .AutoFilter Field:=5, Criteria1:="<=2"

 End With

 Count = WorksheetFunction.Subtotal(3, 
 Range("A1").CurrentRegion.Columns(1)) - 1

 i = 2
 j = Int(Count * Rnd(1)) + 1

    For i = 2 To MaxRow

        If Rows(i).EntireRow.Hidden = False Then

            j = j - 1

            If j = 0 Then

                Rows(i).Select

                Exit For

            End If

        End If

    Next i

 End Sub

フィルターでデータを抽出した後に、抽出後のデータをランダムで1行取り出したいです。

現状でもある程度選択する事は出来ているのですが、データ件数が75000件ございますので、スピードを上げる為にはfor文の所を改善すべきだと思うのですがイマイチどうしていいのか分かりません。
どなたかご教授頂けますと幸いでございます。
宜しくお願い致します。

< 使用 Excel:Excel2019、使用 OS:Windows10 >


SpecialCells(xlCellTypeVisible)使えば
If Rows(i).EntireRow.Hidden = False Then
省ける。

そして絞った行で抽出を行う

Sub ss()
Dim mRng As Range, tRng As Range
Dim Count As Long
Dim i As Long
Set mRng = Range("A1").CurrentRegion
'項目行を省く
Set mRng = Intersect(mRng, mRng.Offset(1, 0))
'可視セル
Set mRng = mRng.SpecialCells(xlCellTypeVisible)
'1列に絞る(A列)
Set mRng = Intersect(mRng, Range("A:A"))
Debug.Print mRng.Address

Count = mRng.Cells.Count
j = Int(Count * Rnd(1)) + 1

For Each tRng In mRng

    j = j - 1
    If j = 0 Then
        Debug.Print tRng.Address
        Rows(tRng.Row).Select
    End If
Next

End Sub

(あい) 2021/08/04(水) 14:18


  > With Range(Cells(2, 1), Cells(MaxRow, 37))
                     ↑
      1.ここ何故2(行目)なのですか?

      2.ご提示のコードでホントに仕様通り動いていますか?

(半平太) 2021/08/04(水) 14:47


半平太さんコメント頂きありがとうざいます。

1行目でしたね。
With Range(Cells(1, 1), Cells(MaxRow, 37))

上手くは動いていたのですが、途中で変に動作する事がありましたがここが原因と気づきませんでした。

あいさんコードありがとうございます。
コードを理解しようとしているのですが、まだ完全に理解出来ていません。
もう少々お待ち下さいませ。
(おきた) 2021/08/04(水) 19:03


 >1行目でしたね。
 >With Range(Cells(1, 1), Cells(MaxRow, 37))

 それで疑問が解けた。 

 以下、AL列に連番を振っておいて、Aggregate関数を利用して非表示行を無視した行番号を求める案

 Sub Sample6()
     Dim MaxRow  As Long
     Dim Count  As Long
     Dim i  As Long
     Dim j  As Long

     ActiveSheet.AutoFilterMode = False

     MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

     With Range(Cells(1, 1), Cells(MaxRow, 37))
         .AutoFilter Field:=1, Criteria1:="3"
         .AutoFilter Field:=2, Criteria1:="5"
         .AutoFilter Field:=3, Criteria1:="6"
         .AutoFilter Field:=4, Criteria1:="30"
         .AutoFilter Field:=5, Criteria1:="<=2"
     End With

     Count = WorksheetFunction.Subtotal(3, Range("A1").CurrentRegion.Columns(1)) - 1
     j = Int(Count * Rnd(1)) + 1

     With Cells(1, 38)
         .EntireColumn.Clear '念の為、作業列を初期化
         .Value = 1
         .AutoFill Destination:=.Resize(MaxRow), Type:=xlFillSeries
         i = Application.Aggregate(15, 5, .Resize(MaxRow), j + 1) 'タイトル行分を上乗せ
         Rows(i).Select
         .EntireColumn.Clear '更地に戻す
     End With

 End Sub

(半平太) 2021/08/04(水) 19:36


あいさん、半平太さんありがとうございます。

お二方のコードにて解決する事が出来ました。
誠にありがとうございました。
(おきた) 2021/08/04(水) 20:01


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.