返回列表 上一主題 發帖

三個工作表合併問題

aok669

帖子
18 
主題
6 
精華
0 
積分
24 
點名
0  
作業系統
xp 
軟體版本
sp3 
閱讀權限
10 
註冊時間
2010-6-2 
最後登錄
2010-12-16 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 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欄主力

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

感謝各位前輩的解答


1213.rar (16.24 KB)
收藏 分享

aok669

帖子
18 
主題
6 
精華
0 
積分
24 
點名
0  
作業系統
xp 
軟體版本
sp3 
閱讀權限
10 
註冊時間
2010-6-2 
最後登錄
2010-12-16 

論壇贊助勳章
9#
發表於 2010-12-16 18:47 | 只看該作者
回復 8# Hsieh


     感謝大大的回覆

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

aok669

帖子
18 
主題
6 
精華
0 
積分
24 
點名
0  
作業系統
xp 
軟體版本
sp3 
閱讀權限
10 
註冊時間
2010-6-2 
最後登錄
2010-12-16 

論壇贊助勳章
7#
發表於 2010-12-15 16:51 | 只看該作者
本帖最後由 aok669 於 2010-12-15 17:00 編輯

回復 6# Hsieh


感謝大大的回覆

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

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

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



例如未類進去的有 2801 彰銀



賣超再拜託大大您了




大大再拜託您了

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

aok669

帖子
18 
主題
6 
精華
0 
積分
24 
點名
0  
作業系統
xp 
軟體版本
sp3 
閱讀權限
10 
註冊時間
2010-6-2 
最後登錄
2010-12-16 

論壇贊助勳章
5#
發表於 2010-12-15 10:59 | 只看該作者
回復 4# GBKEE


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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2010-12-15 08:38 | 只看該作者
回復 3# aok669
股市我不太懂請問,圖一: 2409友達的投信賣超-522 ,如何變成 圖二:轉到外資賣超-522

TOP

aok669

帖子
18 
主題
6 
精華
0 
積分
24 
點名
0  
作業系統
xp 
軟體版本
sp3 
閱讀權限
10 
註冊時間
2010-6-2 
最後登錄
2010-12-16 

論壇贊助勳章
3#
發表於 2010-12-14 23:46 | 只看該作者
本帖最後由 aok669 於 2010-12-15 11:04 編輯

感謝GBKEE大大抽空回答問題

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

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

所以在main顯示如圖

收盤,漲跌請直接複製



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

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

請拜託大大了

q.png (1.27 KB)

q.png

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼

TOP

        靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。
返回列表 上一主題