各位好，想請問關於Excel篩選功能配合VBA使用，有沒有辦法達成「跳到下一個項目」

misser wrote:
剛看了一下訊息，下載(恕刪)

稻草人到處草人 wrote:
忘了說我的需求看起來(恕刪)

misser wrote:
先處理A也是OK的。(恕刪)

稻草人到處草人 wrote:
感謝M大，分享寶貴的...(恕刪)

misser wrote:
上面的VBA，實際的操作示範影片來了

'需建立樞紐分析表，詳細請看附件
Dim List_Index As Integer


Sub test()
    Dim LastRow As Integer
    
    LastRow = Sheets("工作表2").Cells(Sheets("工作表2").Rows.Count, "A").End(xlUp).Row - 2
    If List_Index = LastRow Or List_Index = 0 Then List_Index = 2 Else List_Index = List_Index + 1
    Sheets("sheet1").Range("A:I").AutoFilter Field:=2, Criteria1:=Sheets("工作表2").Cells(List_Index, 1).Value
    'debug
    Sheets("sheet1").Range("m1") = Sheets("工作表2").Cells(List_Index, 1).Value & "=" & Sheets("工作表2").Cells(List_Index, 2).Value
    
End Sub

misser wrote:
上面的VBA，實際的(恕刪)

snare wrote:
如果配合樞紐分析表使(恕刪)

misser wrote:
上面的VBA，實際的(恕刪)

snare wrote:
如果配合樞紐分析表使(恕刪)

snare wrote:
如果配合樞紐分析表使(恕刪)

稻草人到處草人 wrote:
...真正「被需要」的技術幾乎都是「問題出現」的時候...

稻草人到處草人 wrote:
只要修改幾個地方就可以更換篩選的目標欄位，還是說要改動的部分有點多?

稻草人到處草人 wrote:
如果我想把「篩選欄位」換成別的欄位的話

'程式 by misser 109.9.4
Sub auto_next() '自動篩選下一位

col_f = ActiveCell.Column  '游標所在欄=要進行篩選的欄位
row_f = ActiveCell.Row   '游標所在列
col_s = Cells(1, Columns.Count).End(xlToLeft).Column  '資料最後一欄欄位(最右)

If row_f > 1 Or col_f > col_s Then   '提醒使用者
    MsgBox "請先將游標放到要篩選的標題上，再執行本功能喔！"
    Exit Sub   '離開本程序
End If

On Error GoTo err_hand '以下程式執行若發生錯誤，就跳到 errhand:位置 (最底下)
err_f = 0 ' 執行錯誤判斷旗標
r_f = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlVisible).Rows(1).Row
    '取得目前篩選得到的第一筆資料真實列數(若目前未執行篩選，會發生錯誤，程式跳到 errhand:)
    
If err_f = 1 Then r_f = 2 Else r_f = r_f + 1
    '如果上一步驟發生錯誤，就從第2列開始檢查
    '如果沒錯，就從目前篩選的列數，往下一列，準備檢查

Do
    If Cells(r_f, 1) = "" Then  '改由A欄判斷資料是否結束
            MsgBox "已勾選結束囉！"
            Exit Do  '跳出迴圈
        ElseIf Excel.Application.WorksheetFunction.CountIf(Range(Cells(2, col_f), Cells(r_f, col_f)), "=" & Cells(r_f, col_f)) = 1 Then
            '檢查該列的姓名，若是第一次出現(由2~目前列)，就執行篩選該人員    '篩選從B欄改成目前游標所在欄
            
            ActiveSheet.Range(Columns(1), Columns(col_s)).AutoFilter Field:=col_f, Criteria1:=Cells(r_f, col_f)  '在篩選中勾選這位
            ''篩選從B欄改成目前游標所在欄
            
            ActiveSheet.AutoFilter.Range.SpecialCells(12).Copy '將篩選結果放到剪貼簿，方便使用者下一步處理
            
            'Exit Sub
            Exit Do '跳出迴圈
    End If
    r_f = r_f + 1
Loop

Exit Sub  '離開本程序

err_hand:  '錯誤(無篩選狀態)處理
    err_f = 1  '將錯誤旗標設為1
    Resume Next  '程式回到錯誤點的下一步繼續執行
End Sub

'Sheets("sheet1").Range("M1") = Sheets("工作表2").Cells(List_Index, 1).Value & "=" & Sheets("工作表2").Cells(List_Index, 2).Value