Excel vbaは、オートフィルターのドロップダウンメニューで次のオプションを選択します

Question

私は数百列のデータを持ついくつかの列を持っています。私の役割の1つはデータを見ることです（最も一般的には2列目）。そのため、列見出しの小さなドロップダウン矢印をクリックして自動フィルタリストを開き、最初の値を選択解除してから次の値を選択します。同様に、メニューを開き、2番目の値の選択を解除し、3番目の値を選択します。

固定数の値もありません。異なるデータシートは、様々な量のデータを有する。データは通常0,10,40,50,60、...のようになります。しかしそれは配列です。すべてのデータはすでに増加しています。

は私が必要なもの：

1. は、好ましくは、ボタンは、現在選択されている値を選択解除している（2列目用）をクリックし、次の値とフィルタアウト
2. 会話を選択します。私。現在の値を選択解除し、以前の値に

を選択基本的に私は私のデータのための戻る進むとボタンを必要としています。

これは私が自分の行動を記録しようとしたときに得られるものです。

Sub a() 

ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1: 
    ="750385/000" 
    ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1: 
    ="750385/010" 
ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1: 
    ="750385/017" 

End Subの

任意の助けに感謝！

Answer 1

私はこのようなことをします。

最初に、列Bのすべての固有データをコピーするヘルプカラムXを取得します。

Option Explicit 

Sub CreateUniqueList() 
Dim lastrow As Long 

lastrow = Cells(Rows.Count, "B").End(xlUp).Row 

    ActiveSheet.Range("B1:B" & lastrow).AdvancedFilter _ 
    Action:=xlFilterCopy, _ 
    CopyToRange:=ActiveSheet.Range("X1"), _ 
    Unique:=True 
    ActiveSheet.Range("Y1").Value = "x" 
End Sub 

あなたのリストは次のようにその後lokkできます。このような

何か：その後

、あなたはボタンのループが必要になります。

//コードは//

Sub butNextValue() 
Dim lastrow As Long 

lastrow = Cells(Rows.Count, "B").End(xlUp).Row 


For i = 2 To lastrow 
    If ActiveSheet.Cells(i, 25).Value = "x" Then 
     If Not ActiveSheet.Cells(i+1, 24)-value = "" Then 'check if next value is there 
      ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:=ActiveSheet.Cells(i+1, 24)-value 
     Else 
      MsgBox "No more Next Values" 
     End If 
     Exit For 
    End If 
Next i 

End Sub 

Sub butPriValue() 
Dim lastrow As Long 

lastrow = Cells(Rows.Count, "B").End(xlUp).Row 


For i = 2 To lastrow 
    If ActiveSheet.Cells(i, 25).Value = "x" Then 
     If Not ActiveSheet.Cells(i-1, 24)-value = "Set" OR Not ActiveSheet.Cells(i-1, 24)-value = "" Then 'check if next value is there 
      ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:=ActiveSheet.Cells(i-1, 24) 
     Else 
      MsgBox "No more Pri Values" 
     End If 
     Exit For 
    End If 
Next i 

End Sub 

Answer 2

をTestetされていない私はそれをフィルタリングする、シートの上にスピンボタンを使用すると、列の最初のセルにリンクします。

（私はspbFilterChangeそれを呼び、$ B $ 1へのリンク）

（ここでは画像のアップロードdoesntの仕事、申し訳ありません）

次に、あなたがあなたのワークシートのモジュールに次のコードを置くことができます。

を

Private Sub spbFilterChange_SpinDown() 
    Change_Filter Me.Range(Me.spbFilterChange.LinkedCell), False 
End Sub 

Private Sub spbFilterChange_SpinUp() 
    Change_Filter Me.Range(Me.spbFilterChange.LinkedCell), True 
End Sub 

そして標準モジュールに次のサブ：

Option Explicit 

Sub Change_Filter(SortField As Range, Up As Boolean) 
Dim Filter_Values As Collection 
Dim Value_Arr, Val, Sort_Value As String 
Application.ScreenUpdating = False 
    ' Find Unique Values in relevant Column -> Collection 
    Set Filter_Values = New Collection 
    SortField.Offset(2, 0).Areas(1).AutoFilter SortField.Column 
    Value_Arr = SortField.Parent.Range(SortField.Offset(3, 0), SortField.Parent.Cells(SortField.Parent.Rows.Count, SortField.Column).End(xlUp)).Value2 
    On Error Resume Next 
    For Each Val In Value_Arr 
     Filter_Values.Add Val, CStr(Val) 
    Next Val 

    ' Check if Value of LinkedCell is in range 
    If SortField.Value < 1 Or SortField.Value > Filter_Values.Count Then SortField.Value = 1 

    ' set autofilter 
    Sort_Value = Filter_Values(SortField.Value) 
    SortField.Offset(2, 0).AutoFilter SortField.Column, Sort_Value 
Application.ScreenUpdating = True 
End Sub 

これはあなたの問題を解決するはずで、異なる列とシートで使用できます（ワークシートモジュールにイベントプロシージャの別のコピーを追加する必要があります）。

Answer 3

curentフィルタを読み出す方法があります。そこから、その値を見つけるまで列をループできます。ここでは、次の行の値にジャンプするだけで、フィルタに入れることができます。

だから、結論では、この方法は、あなたの「フォワード」

Sub test() 
    Dim startRow As Integer 
    startRow = 2 
    Dim rangeString As String 
    rangeString = "$A$2:$V$609" 


    Dim rng As Range 
    Set rng = Range(rangeString) 

    Dim currentCrit As String 
    currentCrit = rng.Parent.AutoFilter.Filters(2).Criteria1 
    currentCrit = Right(currentCrit, Len(currentCrit) - 1) 

    Dim i As Integer 
    For i = startRow To startRow + rng.Rows.Count 
     If Cells(i, 2).Value = currentCrit Then 
      i = i + 1 
      Exit For 
     End If 
    Next 

    If i > rng.Rows.Count + startRow Then 
     Exit Sub 
    End If 

    ActiveSheet.Range(rangeString).AutoFilter Field:=2, Criteria1:=Cells(i, 2).Value 
End Sub 

注 - ボタンのようになります。これは非常に部品を交換された場合、重複は、あなたの列Bに存在する場合、このwon't作業Forループを使用して以下を入力してください。

Dim i As Integer 
Dim bool As Boolean 
bool = False 
For i = startRow To startRow + rng.Rows.Count 
    If Cells(i, 2).Value = currentCrit Then 
     bool = True 
    End If 

    If bool And Cells(i, 2).Value <> currentCrit Then 
     Exit For 
    End If 
Next 

希望すると助かります。