三個工作表合併問題

aok669

各位前輩好

有三個工作表,第一是投信,第二是外資,第三是主力,main工作表是整合三個工作表的資料

整合買超及賣超的資料,main工作表中,A欄為股票名稱,B欄為收盤價,C欄為漲跌

D~F欄為買超欄,D欄為投信,E欄為外資,F欄為主力,
I~K欄賣超欄,I欄為投信,J欄為外資,K欄主力

將各股票的買賣超的值,整合至歸類的欄位中,以大至小排序

感謝各位前輩的解答


1213.rar (16.24 KB)

下載次數: 19

2010-12-14 03:01

GBKEE

回復 1# aok669
   

1. Sub Ex()
   
2.     Dim D As Object, Sh As Worksheet, R As Range, i%, S$, ii
   
3.     Set D = CreateObject("Scripting.Dictionary")
   
4.     For Each Sh In Sheets
   
5.         If Sh.Name <> "main" Then
   
6.             With Sh
   
7.                 i = .Range("a1").End(xlDown).Row
   
8.                 For Each R In .Range("A3:A" & i & ",F3:F" & i)
   
9.                     S = .Name & .Cells(1, R.Column) & R(1, 2)
   
10.                     D(S) = Array(R(1, 3), R(1, 4), R(1, 5))
    
11.                 Next
    
12.             End With
    
13.         End If
    
14.     Next
    
15.     With Sheets("MAIN")
    
16.         i = .Range("a" & Rows.Count).End(xlUp).Row
    
17.         For Each R In .Range("A3:A" & i)
    
18.             For ii = 4 To 6
    
19.                 S = .Cells(2, ii) & .[D1] & R
    
20.                 If D.exists(S) Then
    
21.                     If R(1, 2) = "" Then R(1, 2) = D(S)(1)
    
22.                     If R(1, 3) = "" Then R(1, 3) = D(S)(2)
    
23.                     R(1, ii) = D(S)(0)
    
24.                 Else
    
25.                     R(1, ii) = ""
    
26.                 End If
    
27.             Next
    
28.             For ii = 9 To 11
    
29.                 S = .Cells(2, ii) & .[i1] & R
    
30.                 If D.exists(S) Then
    
31.                     If R(1, 2) = "" Then R(1, 2) = D(S)(1)
    
32.                     If R(1, 3) = "" Then R(1, 3) = D(S)(2)
    
33.                     R(1, ii) = D(S)(0)
    
34.                 Else
    
35.                     R(1, ii) = ""
    
36.                 End If
    
37.             Next
    
38.             If Application.Sum(R(1, 4).Resize(, 3), R(1, 9).Resize(, 3)) = 0 Then
    
39.                 R(1, 2) = ""
    
40.                 R(1, 3) = ""
    
41.             End If
    
42.         Next
    
43.     End With
    
44. End Sub

複製代碼

aok669

感謝GBKEE大大抽空回答問題

在 main中,小弟只是先將4隻股票的邏輯打入,
在投信,外資,主力的分頁,共有100多隻要分類

例如 2409友達 在投信是賣超-522,在外資是買超8647,在主力則無買超與賣超的紀錄

所以在main顯示如圖

收盤,漲跌請直接複製

下載 (7.19 KB)

2010-12-15 10:55

大大您可以將 +正值視為 買超 ，  -負值視為賣超,這樣邏輯比較好代入

排序方面,買超 正值越高,排越上面 , 賣超 負值越高排越上面

請拜託大大了

GBKEE

回復 3# aok669
股市我不太懂請問,圖一: 2409友達的投信賣超-522 ,如何變成 圖二:轉到外資賣超-522

aok669

回復 4# GBKEE


    對不起, GBKEE 大大,請以圖一(最上面)為準,圖二是我不知如何刪除,所以就遺留下來了,感謝

Hsieh

不懂所謂排序的規則
單純將3表資料歸至1表試試

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. Dim A As Range, B As Range, C As Range, r&
   
5. For Each sh In Sheets(Array("投信", "外資", "主力"))
   
6. With sh
   
7. r = 3
   
8.    Do Until .Cells(r, 2) = ""
   
9.    Set A = .Cells(r, 2)
   
10.    Set B = .Cells(r, 7)
    
11.       d(A.Text) = Array(A.Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
    
12.       d1(A & sh.Name & .[A1]) = A.Offset(, 1).Value
    
13.       d1(B & sh.Name & .[F1]) = B.Offset(, 1).Value
    
14.       r = r + 1
    
15.    Loop
    
16. End With
    
17. Next
    
18. With Sheets("main")
    
19. .[A3:F65536,I3:K65536] = ""
    
20. .[A3].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
    
21. r = 3
    
22. For Each ky In d.keys
    
23.    For Each i In Array(4, 5, 6, 9, 10, 11)
    
24.       Set A = .Cells(r, i)
    
25.       Set B = .Cells(2, i)
    
26.       Set C = .Cells(1, i).MergeArea(1)
    
27.       A.Value = d1(ky & B & C)
    
28.    Next
    
29.    r = r + 1
    
30. Next
    
31. End With
    
32. End Sub

複製代碼

aok669

回復 6# Hsieh


感謝大大的回覆

大大已經完成了一半,不過

買超的部份,投信與外資與主力完全正確的,
賣超的部份,投信,外資,主力,都未分類

請大大看程式執行後的畫面

下載 (19.14 KB)

2010-12-15 16:51

例如未類進去的有 2801 彰銀

下載 (7.28 KB)

2010-12-15 16:59

賣超再拜託大大您了




大大再拜託您了

Hsieh

回復 7# aok669

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. Dim A As Range, B As Range, C As Range, r&
   
5. For Each sh In Sheets(Array("投信", "外資", "主力"))
   
6. With sh
   
7. r = 3
   
8.    Do Until .Cells(r, 2) = ""
   
9.    Set A = .Cells(r, 2)
   
10.    Set B = .Cells(r, 7)
    
11.       d(A.Text) = Array(A.Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
    
12.       d(B.Text) = Array(B.Value, B.Offset(, 2).Value, B.Offset(, 3).Value) '加入這行
    
13.       d1(A & sh.Name & .[A1]) = A.Offset(, 1).Value
    
14.       d1(B & sh.Name & .[F1]) = B.Offset(, 1).Value
    
15.       r = r + 1
    
16.    Loop
    
17. End With
    
18. Next
    
19. With Sheets("main")
    
20. .[A3:F65536,I3:K65536] = ""
    
21. .[A3].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
    
22. r = 3
    
23. For Each ky In d.keys
    
24.    For Each i In Array(4, 5, 6, 9, 10, 11)
    
25.       Set A = .Cells(r, i)
    
26.       Set B = .Cells(2, i)
    
27.       Set C = .Cells(1, i).MergeArea(1)
    
28.       A.Value = d1(ky & B & C)
    
29.    Next
    
30.    r = r + 1
    
31. Next
    
32. End With
    
33. End Sub

複製代碼

aok669

回復 8# Hsieh


     感謝大大的回覆