c_c_lai

回復 9# blue2263

1. Sub 選股與同產業()
   
2.     Dim 代碼別 As String, 產業別 As Range
   
3.    
   
4.     代碼別 = InputBox("請輸入您欲篩選之股票代碼 (Stock No.)" & vbCrLf & "(例如：1101、1203、1234、或 1439 等) ", "基本資料")     '  彈出輸入視窗
   
5.     If 代碼別 = "" Then Exit Sub
   
6.    
   
7.     With Sheets("對手同產業")
   
8.         .AutoFilterMode = False                              '  取消自動篩選  (回復原始篩選前內容)
   
9.         Set 產業別 = Sheets("對手同產業").[B:B].Find(代碼別, , , 1)
   
10.         If Not 產業別 Is Nothing Then
    
11.             .Range("A1").AutoFilter FIELD:=6, Criteria1:=產業別.Offset(, 4).Value '  自動篩選
    
12.         End If
    
13.     End With
    
14.      
    
15.     With Sheets("選股報表")
    
16.         .AutoFilterMode = False                              '  取消自動篩選  (回復原始篩選前內容)
    
17.         Set 產業別 = Sheets("選股報表").[A:A].Find(代碼別, , , 1)
    
18.         If Not 產業別 Is Nothing Then
    
19.             .Range("A1").AutoFilter FIELD:=4, Criteria1:=產業別.Offset(, 3).Value  '  自動篩選
    
20.         End If
    
21.     End With
    
22. End Sub

複製代碼

blue2263

C大你好
我希望是用代碼來做篩選條件,同下圖
原因是,對手同產業工作表,資料有再細分,細分的意思是,
除了同產業,還有產品相關度較高的,會編到同組代碼
因此用產業別做為篩選條件,兩個工作表結果會不相同

不知是否有方法逹到
謝謝C大熱心幫忙!!

下載 (36.04 KB)

2016-7-29 20:07

c_c_lai

回復 12# blue2263
你希望的結果
是這樣麼？

下載 (92.59 KB)

2016-7-30 10:13

blue2263

回復 13# c_c_lai

回復c大,以水泥工業的產業別來看,會是我要的相同結果沒錯,但其它產業不會是相同結果,
請c大看下圖
以1301代碼篩選只有8家,如果以產業別篩選有288家

下載 (47.51 KB)

2016-8-1 21:05

下載 (126.82 KB)

2016-8-1 21:06

原因是,對手同產業工作表,資料有再細分,細分的意思是,
除了同產業,還有產品相關度較高的,會編到同組代碼
因此用產業別做為篩選條件,兩個工作表結果會不相同

c_c_lai

回復 14# blue2263
你的意思是否如此？

下載 (111.29 KB)

2016-8-2 09:22

下載 (60.31 KB)

2016-8-2 09:22

blue2263

回復 15# c_c_lai
回復C大

下載 (59.15 KB)

2016-8-2 19:18

下載 (116.97 KB)

2016-8-2 19:18

blue2263

回復 15# c_c_lai
謝謝!C大幫忙

GBKEE

回復 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

複製代碼

blue2263

回復 18# GBKEE
測試ok :D
萬分感謝!!G大幫忙解答