- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 9# blue2263
步驟1為手動操作,步驟2希望用VBA的方式執行
步驟2的程式碼- Option Explicit
- Sub Ex()
- Dim i As Integer, Msg As String, D As Object, E As Variant, Rng As Range
- With Sheets("對手同產業")
- If .AutoFilterMode Then '有使用自動篩選(AutoFilter)
- 'If .AutoFilterMode = True Then '有使用自動篩選(AutoFilter)
- With .AutoFilter.Filters(1)
- '** Filter物件的集合,代表自動篩選範圍中的所有篩選
- '** On 屬性 如果指定的篩選已開啟,則為 True。唯讀 Boolean
- If .On Then Msg = Mid(.Criteria1, 2) '**確定[代碼]篩選有指定條件
- End With
- End If
- If Msg = "" Then
- MsgBox .Name & " 代碼 沒指定 !!"
- Else
- Set D = CreateObject("SCRIPTING.DICTIONARY") '**字典物件
- With .Range("B:B").SpecialCells(xlCellTypeVisible) '** 資料篩選後可見的儲存格
- For Each E In .Cells
- If E = "" Then Exit For '** 沒有資料終止迴圈
- If E.Row > 1 Then D(E.Value) = "" '** 字典物件中加入 代碼
- Next
- End With
- With Sheets("選股報表")
- If .AutoFilterMode Then .AutoFilterMode = False '**有使用自動篩選(AutoFilter)
- .Cells.EntireRow.Hidden = False '** 取消所有列的隱藏
- Set Rng = .Rows("3:" & .Range("A1").End(xlDown).Row) '** 設定資料的範圍
- Rng.EntireRow.Hidden = True '** 範圍的列隱藏
- For Each E In Rng.Rows ' ** 範圍列 的迴圈
- If D.exists(E.Cells(1, 1).Value) Then '**字典物件的key值有 代碼
- E.EntireRow.Hidden = False '** 取消列的隱藏
- D.Remove (E.Cells(1, 1).Value) '**Remove 方法 把成員從 Collection 物件中移除。
- If D.Count = 0 Then Exit For ' '** Count 物件中成員的總數
- End If
- Next
- End With
- MsgBox Msg & " 選股報表 Ok"
- End If
- End With
- End Sub
複製代碼 |
|