請教比對工作表相同的項目

bhsm

各位前輩好:
       小弟想比較8個工作表中A欄相同的值,列於Main工作表中,小弟有參考網路的前輩寫的VBA自行修改,但卻無法比對,不知VBA哪裡有錯?請指教.謝謝.
       比較.rar (15.22 KB)

下載次數: 12

2012-4-13 13:13

bhsm

感謝GBKEE大大,您真是設想周到.小弟沒想到的.您都替我想到了.真是謝謝.

bhsm

感謝register313 大大,非常實用,小弟先消化一下,若有問題尚請不吝指教.謝謝

GBKEE

回復 3# bhsm
還有賣超一併回答   使用工作表 指令 資料  ->   合併彙算  很快的

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Ar1(), Ar2(), xl As Integer, Rng As Range, xF As Range
   
4.     Sheets("相同").Move Before:=Sheets(1)
   
5.     ReDim  Ar1(2 To Sheets.Count)
   
6.     ReDim  Ar2(2 To Sheets.Count)
   
7.     For xl = 2 To Sheets.Count
   
8.         With Sheets(xl)
   
9.             Set Rng = .Range("A5", .[A5].End(xlDown)(1, 2))
   
10.             Ar1(xl) = Rng.Address(, , xlR1C1, 1)
    
11.             Set Rng = .Range("E5", .[E5].End(xlDown)(1, 2))
    
12.             Ar2(xl) = Rng.Address(, , xlR1C1, 1)
    
13.         End With
    
14.     Next
    
15.     With Sheets(1)
    
16.         .Cells = ""
    
17.         .[A1] = "買超"
    
18.         .[A2].Consolidate Sources:=Ar1, Function:=xlCount, TopRow:=False, LeftColumn:=True, CreateLinks:=False
    
19.         .[A2].Consolidate Sources:=Ar1, Function:=xlCount, TopRow:=True, LeftColumn:=True, CreateLinks:=False
    
20.         .[E1] = "賣超"
    
21.         .[E2].Consolidate Sources:=Ar2, Function:=xlCount, TopRow:=False, LeftColumn:=True, CreateLinks:=False
    
22.         .[E2].Consolidate Sources:=Ar2, Function:=xlCount, TopRow:=True, LeftColumn:=True, CreateLinks:=False
    
23.     End With
    
24. End Sub

複製代碼

register313

回復 3# bhsm

1. Sub YY()
   
2. R = 1: C = 0
   
3. Sheets("相同").Columns("A:B") = ""
   
4. For Each Sh In Sheets
   
5.   If Sh.Name <> "相同" Then
   
6.      For Each Rng In Range(Sh.[A6], Sh.[A6].End(xlDown))
   
7.        With Sheets("相同")
   
8.          If Application.CountIf(.Columns("A"), Rng.Value) = 0 Then
   
9.             .Cells(R, 1) = Rng.Value
   
10.             .Cells(R, 2) = C + 1
    
11.             R = R + 1
    
12.          Else
    
13.             x = Application.Match(Rng.Value, .Columns("A"), 0)
    
14.             .Cells(x, 2) = .Cells(x, 2) + 1
    
15.          End If
    
16.        End With
    
17.      Next
    
18.   End If
    
19. Next
    
20. End Sub

複製代碼

bhsm

對不起沒說清楚
以"2883開發金"為例,在"一銀.台銀.土銀.台企.兆豐.合庫.華南.彰銀"工作表中.共出現7次
以"2330台積電"為例,在"一銀.台銀.土銀.台企.兆豐.合庫.華南.彰銀"工作表中.共出現6次
其他還有各股各出現的次數
想請教的是: 是否可用vba找出在這8個工作表中.同時出現的股票及次數填入Main工作表中.謝謝

GBKEE

回復 1# bhsm
A欄相同的值 要說明白