[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フィルター後の行番号を取得したい』(おきた)
分からない事がありましたので質問させて頂きます。
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 >
そして絞った行で抽出を行う
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.