返回列表 上一主題 發帖

[發問] 篩選資料問題

回復 9# blue2263
步驟1為手動操作,步驟2希望用VBA的方式執行
步驟2的程式碼
  1. Option Explicit
  2. Sub Ex()
  3.     Dim i As Integer, Msg As String, D As Object, E As Variant, Rng As Range
  4.     With Sheets("對手同產業")
  5.         If .AutoFilterMode Then   '有使用自動篩選(AutoFilter)
  6.         'If .AutoFilterMode = True Then '有使用自動篩選(AutoFilter)
  7.            With .AutoFilter.Filters(1)
  8.                 '** Filter物件的集合,代表自動篩選範圍中的所有篩選
  9.                 '** On 屬性  如果指定的篩選已開啟,則為 True。唯讀 Boolean
  10.                 If .On Then Msg = Mid(.Criteria1, 2)   '**確定[代碼]篩選有指定條件
  11.             End With
  12.         End If
  13.         If Msg = "" Then
  14.             MsgBox .Name & " 代碼 沒指定 !!"
  15.         Else
  16.             Set D = CreateObject("SCRIPTING.DICTIONARY")            '**字典物件
  17.             With .Range("B:B").SpecialCells(xlCellTypeVisible)              '** 資料篩選後可見的儲存格
  18.                 For Each E In .Cells
  19.                    If E = "" Then Exit For                                                      '** 沒有資料終止迴圈
  20.                    If E.Row > 1 Then D(E.Value) = ""                                    '** 字典物件中加入 代碼
  21.                 Next
  22.             End With
  23.             With Sheets("選股報表")
  24.                 If .AutoFilterMode Then .AutoFilterMode = False                  '**有使用自動篩選(AutoFilter)
  25.                 .Cells.EntireRow.Hidden = False                                           '** 取消所有列的隱藏
  26.                 Set Rng = .Rows("3:" & .Range("A1").End(xlDown).Row)  '** 設定資料的範圍
  27.                 Rng.EntireRow.Hidden = True                                             '**  範圍的列隱藏
  28.                 For Each E In Rng.Rows                                                      ' ** 範圍列 的迴圈
  29.                     If D.exists(E.Cells(1, 1).Value) Then                               '**字典物件的key值有 代碼
  30.                         E.EntireRow.Hidden = False                                        '** 取消列的隱藏
  31.                         D.Remove (E.Cells(1, 1).Value)                                  '**Remove 方法 把成員從 Collection 物件中移除。
  32.                         If D.Count = 0 Then Exit For                                       ' '** Count 物件中成員的總數
  33.                     End If
  34.                 Next
  35.             End With
  36.             MsgBox Msg & " 選股報表 Ok"
  37.         End If
  38.     End With
  39. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 【時間成就一切】時間可以造就人格,可以成就事業,也可以儲積功德。
返回列表 上一主題