オートフィルター-SpecialCellsの使用
バックグラウンド：
私は何度も AutoFilter を適用しており、なぜそれが時々機能するのかについて自分自身に本当に尋ねたことはありません。フィルタリングされたデータの結果を操作することは、特にSpecialCellsが関係する場合に、混乱を招くことがあります。
以下のシナリオで詳しく説明します。
テストデータ：
| Header1 | Header2 |
|---------|---------|
| 50 | |
| 10 | |
| 30 | |
| 40 | |
| 20 | |
コード1-プレーンAutoFilter：
With Sheets("Sheet1").Range("A1:B6")
.AutoFilter 1, ">50"
.Columns(2).Value = "Check"
.AutoFilter
End With
これは（SpecialCells(12)を使用しなくても）機能しますが、B1に入力されます。
コード2-.Offsetの使用：
上記の動作を防ぐために、次のようにOffsetを実装できます。
With Sheets("Sheet1").Range("A1:B6")
.AutoFilter 1, ">50"
.Columns(2).Offset(1).Value = "Check"
.AutoFilter
End With
ただし、これでデータの下の行、セルB7にデータが入力されます。
コード3-.Resizeの使用：
.OffsetにB7が入力されないようにするには、.Resizeを含める必要があります。
With Sheets("Sheet1").Range("A1:B6")
.AutoFilter 1, ">50"
.Columns(2).Offset(1).Resize(5, 1).Value = "Check"
.AutoFilter
End With
B1とB7にデータが入力されないようにしましたが、B2:B6にデータが入力されましたが、AutoFilterメカニズムは「壊れている」ようです。以下のスクリーンショットで表示してみました。真ん中は">30"でフィルタリングされたときであり、右側は">50"でフィルタリングされたときです。私が見ているように、これは、参照範囲がゼロの可視セルで構成されているという事実に関係しています。
コード4-.SpecialCellsの使用：
私がここで行う通常のことは、最初に可視セルをCountにすることです（error 1004を防ぐために範囲内のヘッダーを含みます）。
With Sheets("Sheet1").Range("A1:B6")
.AutoFilter 1, ">50"
If .SpecialCells(12).Count > 2 Then .Columns(2).Offset(1).Resize(5, 1).Value = "Check"
.AutoFilter
End With
質問：
ご覧のとおり、B1が上書きされるのを防ぐために、.Columns(2).Value = "Check"からIf .SpecialCells(12).Count > 2 Then .Columns(2).Offset(1).Resize(5, 1).Value = "Check"に完全に移動しました。
どうやら、AutoFilterメカニズムは、最初のシナリオでは可視の行自体を検出するために非常にうまく機能しますが、ヘッダーが上書きされないようにするには、実装する必要がありました。
私はここで物事を複雑にしていますか？それより短いルートがありますか？また、セルが表示されなくなると、なぜすべての範囲の非表示のセルにデータが入力されるのですか。実際にフィルタリングされたデータがある場合にうまく機能します。これはどのようなメカニズムですか（コード3を参照）？
それほどエレガントではない（IMO）オプションは、B1を書き換えることです。
With Sheets("Sheet1").Range("A1:B6")
.AutoFilter 1, ">50"
Var = .Cells(1, 2): .Columns(2).Value = "Check": .Cells(1, 2) = Var
.AutoFilter
End With
問題は明らかにテーブル内の非表示の行を処理することから生じているため、これに対処する最も簡単な方法は、表示セルを操作および確認できるテーブルボディ範囲を作成することです。
表示されている行にマークを付ける場合は、非表示の行よりも少し簡単です。それ以外の場合は、ダミー変数を作成し、再表示し、空白を埋めて、ダミー変数を削除する必要があります。
例えば
Sub AutoFilterTable()
Dim SrcRange As Range: Set SrcRange = Sheets("Sheet1").Range("A1:B6")
Dim BodyRange As Range: Set BodyRange = Application.Intersect(SrcRange, SrcRange.Offset(1, 0))
With SrcRange
BodyRange.Columns(2).ClearContents
.AutoFilter 1, ">30"
On Error Resume Next
BodyRange.Columns(2).SpecialCells(xlCellTypeVisible) = "Check"
.AutoFilter
End With
End Sub
ダミー変数の使用
Sub AutoFilterTable()
Dim SrcRange As Range: Set SrcRange = Sheets("Sheet1").Range("A1:B6")
Dim BodyRange As Range: Set BodyRange = Application.Intersect(SrcRange, SrcRange.Offset(1, 0))
With SrcRange
BodyRange.Columns(2).ClearContents
.AutoFilter 1, ">30"
On Error Resume Next
BodyRange.Columns(2).SpecialCells(xlCellTypeVisible) = "Dummy"
.AutoFilter
BodyRange.Columns(2).SpecialCells(xlCellTypeBlanks) = "Check"
BodyRange.Columns(2).Replace "Dummy", ""
End With
End Sub
次に、コード3に関する質問：.Columns（2）.Offset（1）が非表示の行であるかどうか（および他の行が非表示であるかどうか）によって異なります
表示されている場合、期待どおりに機能します。実際、表示されている行が存在する場合、非表示であるかどうかに関係なく、行の上でサイズを変更すると、表示されているセルが選択されます。ただし、すべての行が非表示になっている場合でも、オフセット範囲は「アクティブ」なので、セルを表示せずにサイズ変更して範囲を包含すると、最終的にすべてのセルが選択されます。
ここには多くの巧妙なアプローチがあります。少し古風な鉱山を採掘しましたが、機能しているようです（質問で提供された表を使用してテストしました）
Sub SetFilteredCell()
Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet4") ' Change sheet reference
Dim iLRow As Long: iLRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row ' Presuming that first row is the header
Dim oRng As Range: Set oRng = oWS.Range("A1:B" & iLRow) ' Set range here
Dim rFilteredRng As Range
Dim oCRng As Range
' Clear any existing filter
oWS.AutoFilterMode = False
' Set autofilter
oRng.AutoFilter Field:=1, Criteria1:=">20"
' Check if autofilter returned any rows
If oWS.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 > 0 Then
' Set filtered range
Set rFilteredRng = oRng.Cells.SpecialCells(xlCellTypeVisible)
' Loop through all filtered rows
For Each oCRng In rFilteredRng.Rows
' Skipping first row as the presumption is that its the header row
If oCRng.Row > 1 Then
oWS.Cells(oCRng.Row, 2).Value = "Check"
End If
Next
End If
' Clear filter
oWS.AutoFilterMode = False
End Sub
参考：この質問
Range.AutoFilterメソッド（Excel） は、フィルター条件を範囲に適用しているため、期待どおりに機能しています。Range.SpecialCellsメソッド（Excel） 範囲内で目に見えるセルに遭遇した結合範囲を返すので、期待どおりに動作しています適用先。
SpecialCellsメソッドが範囲全体Range("A1:B6")に適用されると、予期しない結果が生成されます。ヘッダーが表示されるため、結果の範囲に含まれます。
SpecialCellsメソッドはユニオン範囲（複数の領域）を返す可能性があるため、「ターゲット」に適用することをお勧めしますRange値「Check」で更新する必要があります。 Column(2)。
また、AutoFilterが可視の行を返さない場合を管理するには、On Error statementを使用する必要があります。
次の手順では、それぞれの値を更新する両方のフィルターを適用します。
Sub Range_AutoFilter()
With ThisWorkbook.Sheets(1).Range("A1:B6")
.AutoFilter 1, ">30"
On Error Resume Next
.Cells(2, 2).Resize(-1 + .Rows.Count) _
.SpecialCells(xlCellTypeVisible).Value2 = "Check >30"
On Error GoTo 0
.AutoFilter
.AutoFilter 1, ">50"
On Error Resume Next
.Cells(2, 2).Resize(-1 + .Rows.Count, 1) _
.SpecialCells(xlCellTypeVisible).Value2 = "Check >50"
On Error GoTo 0
.AutoFilter
End With
End Sub
これは、メソッドの適用方法が原因で「予期しない結果」についての説明を追加したいと思った他の回答と同じです。
これは、これらの手順を手動で実行する場合とまったく同じ動作です。
- 範囲にオートフィルターを適用する
- その範囲の2列目を選択します（一番上の行を含む）
- すべてをフィルターで除外します（上部の行のみが表示されます）
- 新しい値を入力し、範囲全体に挿入する Ctrl+Enter （2列目の一番上の行のみが影響を受けます）
![enter image description here]()
ここで、入力する前に下矢印キーを押すと（.Offset(1)と同じ）、次に表示されるセルが選択されます（B7）。
手動で範囲を選択した場合B2:B6自動フィルターを適用する前に（すべてのセルがフィルターで除外されるため）、値を挿入します Ctrl+Enter、すべてのセルが影響を受けます-これは、手動オートフィルターの未処理のEdgeケースであったと思います（ユーザーは非表示のセルにのみ値を挿入しようとしていません）。
次に、SpecialCellsxlCellTypeConstantsとxlCellTypeVisibleをチェーンしてターゲット範囲をトリミングする別のバリエーションを示します。
With Range("A1:B6")
.Offset(1).Columns(2).ClearContents
.AutoFilter 1, ">50", , , True
On Error Resume Next
.Offset(1).SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeVisible).Columns(2) = "Checked"
On Error GoTo 0
.AutoFilter
End With
（限られたテストでは、列2のセルは空である必要があります）.FindNextを使用できます。 SpecialCellsやエラーステートメントは必要ありません。
これをコード3に追加しました。
With Sheets("Sheet1").Range("A1:B6")
.AutoFilter 1, ">50"
If Not .FindNext(.Cells(1)) Is Nothing Then .Columns(2).Offset(1).Resize(5, 1).Value = "Check"
.AutoFilter
End With
編集： FilterTableの横に空白の列があると仮定します
With Sheets("Sheet1").Range("A1:B6")
.AutoFilter 1, ">30"
If Not .Offset(, 1).FindNext() Is Nothing Then .Columns(2).Offset(1).Resize(5, 1).Value = "Check"
.AutoFilter
End With
フィルター後の範囲のdatabodyを変更する場合は、Intersection元の範囲オフセット1行を使用する必要があります=（ヘッダーを省く）とSpecialCells(xlCellTypeVisible)を使用し、次にAreasを実行します。
この例には手がかりがあります：
Option Explicit
Sub MoreThan50()
MoreThanValue "50"
End Sub
Private Sub MoreThanValue(Optional Amount As String = "")
Dim oRng As Range, oRngArea As Range, oRngResult As Range
Set oRng = Sheets(1).Range("A1:B6")
' Clear Previous data on 2nd column
With Intersect(oRng, oRng.Offset(1))
.Columns(2).ClearContents
End With
With oRng
' Apply AutoFilter
.AutoFilter 1, ">" & IIf(Len(Amount) = 0, "50", Amount)
' Update 2nd Column of resulting data
Set oRngResult = Intersect(oRng.Offset(1), .SpecialCells(xlCellTypeVisible))
If Not oRngResult Is Nothing Then
With oRngResult
If .Areas.Count > 0 Then
For Each oRngArea In .Areas
oRngArea.Columns(2).Value = "check"
Next
End If
End With
Set oRngResult = Nothing
End If
.AutoFilter
End With
Set oRng = Nothing
End Sub