Board logo

標題: 三個工作表合併問題 [打印本頁]
作者: aok669    時間: 2010-12-14 03:02     標題: 三個工作表合併問題

本帖最後由 aok669 於 2010-12-14 03:03 編輯

各位前輩好

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

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

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

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

感謝各位前輩的解答


[attach]4075[/attach]
作者: GBKEE    時間: 2010-12-14 08:10

回復 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    時間: 2010-12-14 23:46

本帖最後由 aok669 於 2010-12-15 11:04 編輯

感謝GBKEE大大抽空回答問題

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

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

所以在main顯示如圖

收盤,漲跌請直接複製

[attach]4101[/attach]

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

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

請拜託大大了
作者: GBKEE    時間: 2010-12-15 08:38

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

回復 4# GBKEE


    對不起, GBKEE 大大,請以圖一(最上面)為準,圖二是我不知如何刪除,所以就遺留下來了,感謝
作者: Hsieh    時間: 2010-12-15 11:10

不懂所謂排序的規則
單純將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    時間: 2010-12-15 16:51

本帖最後由 aok669 於 2010-12-15 17:00 編輯

回復 6# Hsieh


感謝大大的回覆

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

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

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

[attach]4105[/attach]

例如未類進去的有 2801 彰銀

[attach]4106[/attach]

賣超再拜託大大您了




大大再拜託您了
作者: Hsieh    時間: 2010-12-15 21:00

回復 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    時間: 2010-12-16 18:47

回復 8# Hsieh


     感謝大大的回覆



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)