|
▼ponpon さん おはようございます。
'提示のコードでは、件数が変化したとき、表示件数を消去できないので、
'表示件数を消去する方法を検討してみました。
'こんな具合でどうですか。
Sub test6()
Dim myR As Range
Dim cnt As Long
Dim 行 As Long
With Worksheets("sheet1")
Set myR = .Range("A1").CurrentRegion
行 = myR.Rows.Count
'
'-------------件数が変化したとき、空白行を調べて件数消去
myR.AutoFilter
With Range("A65336").End(xlUp)
If .Offset(-1) = "" And .Offset(-2) = "" Then .Value = Empty
End With
MsgBox ""
'------------------------ここまで追加
myR.AutoFilter field:=1, Criteria1:="22"
'On Error Resume Next '<----ない方がいいです
cnt = .AutoFilter.Range.Columns(1).SpecialCells _
(xlCellTypeVisible).Count - 1
'On Error GoTo 0'<----ない方がいいです
With .Range("A" & 行).Offset(3, 0)
'.ClearContents '<---件数が変化したとき、消去してくれない
.Value = cnt
End With
End With
End Sub
|
|