Board logo

標題: 請問如何將"股票交易明細"彙整貼入"部位表" [打印本頁]
作者: jasonwu0114    時間: 2013-11-13 11:06     標題: 請問如何將"股票交易明細"彙整貼入"部位表"

請問如何將
”交易明細”表中的明細
依各股加總”數量”及總”金額”
再依個股買/賣
貼入“”部位表””中的買入/賣出股數,金額
如無庫存則依代碼順序新插入一列
貼入代號,名稱,買入/賣出股數,金額

卡住好幾天了
謝謝幫忙
作者: jasonwu0114    時間: 2013-11-21 10:45

回復 1# jasonwu0114


   有高手可以指導一下嗎
謝謝
作者: GBKEE    時間: 2013-11-21 15:25

回復 2# jasonwu0114
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D(1 To 2) As Object, X As Integer, Rng As Range, Ar As Variant, S As String
  4.     Set D(1) = CreateObject("SCRIPTING.DICTIONARY")                '字典物件1
  5.     Set D(2) = CreateObject("SCRIPTING.DICTIONARY")                '字典物件2
  6.     Set Rng = Sheets("交易明細").Range("B4")
  7.     Do While Rng <> ""                                             '迴圈: 讀取 (買,賣) 資料
  8.         With Rng
  9.             If Rng = "買" Then X = 1 Else X = 2                    '字典物件 買(1),賣 (2)
  10.             If Not D(X).Exists(.Offset(, 1).Value) Then            'Exists 字典物件(KEY)是否存在 : 不存在
  11.                 D(X)(.Offset(, 1).Value) = Array(Val(.Offset(, 2)), Val(.Offset(, 2)) * .Offset(, 3).Value) '字典物件(KEY)=陣列
  12.             Else                                                    '字典物件: 存在
  13.                 Ar = D(X)(.Offset(, 1).Value)                       '陣列=字典物件(KEY)
  14.                 Ar(0) = Ar(0) + Val(.Offset(, 2))                   '陣列(0)=Ar(0)+數字
  15.                 Ar(1) = Ar(1) + Val(.Offset(, 2)) * .Offset(, 3)    '陣列(1)=Ar(1)+數字
  16.                 D(X)(.Offset(, 1).Value) = Ar                       '字典物件(KEY)=陣列
  17.             End If
  18.         End With
  19.         Set Rng = Rng.Offset(1)                                     '下一個買,賣資料
  20.     Loop
  21.     Set Rng = Sheets("部位表").Range("A5")
  22.     Do While Rng <> ""                                               '迴圈: 讀取庫存(股票代號)
  23.         With Rng
  24.             S = .Offset(, 1) & " " & Rng                             'S : 字典物件的(KEY)
  25.             If D(1).Exists(S) Then                                   'Exists= True: 字典物件(S)->存在
  26.                 .Range("E1") = D(1)(S)(0)                            'D(1)(S)(0):  字典物件(S)內容為陣列->第(0)元素值
  27.                 .Range("F1") = D(1)(S)(1)
  28.                 D(1).Remove (S)                                      'Remove: 把成員,從字典物件(1)移除
  29.             End If
  30.             If D(2).Exists(S) Then
  31.                 .Range("G1") = D(2)(S)(0)
  32.                 .Range("I1") = D(2)(S)(1)
  33.                 D(2).Remove (S)
  34.             End If
  35.         End With
  36.         Set Rng = Rng.Offset(1)
  37.     Loop
  38.     '*** 無庫存則依代碼順序新插入一列        *********
  39.     For Each Ar In D(1).KEYS                                         'Remove後剩餘的字典物件
  40.         Rng.Resize(, 12).Insert
  41.         'Rng.Insert 插入後,Rng會下移在插入的儲存格下方,繼續插入,Rng會下移在插入的儲存格下方
  42.         With Rng.Offset(-1)
  43.             .Range("A1") = Split(Ar, " ")(1)
  44.             .Range("B1") = Split(Ar, " ")(0)
  45.             .Range("E1") = D(1)(Ar)(0)
  46.             .Range("F1") = D(1)(Ar)(1)
  47.             If D(2).Exists(Ar) Then
  48.                 .Range("G1") = D(2)(Ar)(0)
  49.                 .Range("I1") = D(2)(Ar)(1)
  50.                 D(2).Remove (Ar)
  51.             End If
  52.         End With
  53.     Next
  54.     For Each Ar In D(2).KEYS
  55.         Rng.Resize(, 12).Insert
  56.         With Rng.Offset(-1)
  57.             .Range("A1") = Split(Ar, " ")(1)
  58.             .Range("B1") = Split(Ar, " ")(0)
  59.             .Range("G1") = D(2)(Ar)(0)
  60.             .Range("I1") = D(2)(Ar)(1)
  61.         End With
  62.     Next
  63. End Sub
複製代碼
作者: jasonwu0114    時間: 2013-11-27 15:13

回復 3# GBKEE


    感恩!!!!真是受益良多!!!我想我把書翻爛了也寫不出來
另外再請問
程式中“””無庫存則依代碼順序新插入一列””
執行後好像只會在最後往下新增一列
1.是否可照所有庫存的股票代號順序插入一列或者最後再全部做排序
2.因為儲存格內有計算公式是否可複製整列再新插入
謝謝
作者: GBKEE    時間: 2013-11-27 16:04

本帖最後由 GBKEE 於 2013-11-27 17:45 編輯

回復 4# jasonwu0114
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D(1 To 2) As Object, X As Integer, Rng As Range, Ar As Variant, S As String
  4.     Set D(1) = CreateObject("SCRIPTING.DICTIONARY")                '字典物件1
  5.     Set D(2) = CreateObject("SCRIPTING.DICTIONARY")                '字典物件2
  6.     Set Rng = Sheets("交易明細").Range("B4")
  7.     Do While Rng <> ""                                             '迴圈: 讀取 (買,賣) 資料
  8.         With Rng
  9.             If Rng = "買" Then X = 1 Else X = 2                    '字典物件 買(1),賣 (2)
  10.             If Not D(X).Exists(.Offset(, 1).Value) Then            'Exists 字典物件(KEY)是否存在 : 不存在
  11.                 D(X)(.Offset(, 1).Value) = Array(Val(.Offset(, 2)), Val(.Offset(, 2)) * .Offset(, 3).Value) '字典物件(KEY)=陣列
  12.             Else                                                    '字典物件: 存在
  13.                 Ar = D(X)(.Offset(, 1).Value)                       '陣列=字典物件(KEY)
  14.                 Ar(0) = Ar(0) + Val(.Offset(, 2))                   '陣列(0)=Ar(0)+數字
  15.                 Ar(1) = Ar(1) + Val(.Offset(, 2)) * .Offset(, 3)    '陣列(1)=Ar(1)+數字
  16.                 D(X)(.Offset(, 1).Value) = Ar                       '字典物件(KEY)=陣列
  17.             End If
  18.         End With
  19.         Set Rng = Rng.Offset(1)                                     '下一個買,賣資料
  20.     Loop
  21.     Set Rng = Sheets("部位表").Range("A5")
  22.     Do While Rng <> ""                                               '迴圈: 讀取庫存(股票代號)
  23.         With Rng
  24.             S = .Offset(, 1) & " " & Rng                             'S : 字典物件的(KEY)
  25.             If D(1).Exists(S) Then                                   'Exists= True: 字典物件(S)->存在
  26.                 .Range("E1") = D(1)(S)(0)                            'D(1)(S)(0):  字典物件(S)內容為陣列->第(0)元素值
  27.                 .Range("F1") = D(1)(S)(1)
  28.                 D(1).Remove (S)                                      'Remove: 把成員,從字典物件(1)移除
  29.             End If
  30.             If D(2).Exists(S) Then
  31.                 .Range("G1") = D(2)(S)(0)
  32.                 .Range("I1") = D(2)(S)(1)
  33.                 D(2).Remove (S)
  34.             End If
  35.         End With
  36.         Set Rng = Rng.Offset(1)
  37.     Loop
  38.     Set Rng = Rng.Offset(-1).Resize(, 12)
  39.     '*** 無庫存則依代碼順序新插入一列        *********
  40.     For Each Ar In D(1).KEYS                                       'Remove後剩餘的字典物件
  41.         Rng.Copy                                                   '複製
  42.         Rng.Offset(1).Insert Shift:=xlDown                         '下一列插上複製的儲存格
  43.         
  44.         With Rng.Offset(1)
  45.             .SpecialCells(xlCellTypeConstants, 3) = ""       '清除 下一列插上複製的儲存格的[文字,數字]
  46.             .Range("A1") = Split(Ar, " ")(1)
  47.             .Range("B1") = Split(Ar, " ")(0)
  48.             .Range("E1") = D(1)(Ar)(0)
  49.             .Range("F1") = D(1)(Ar)(1)
  50.             If D(2).Exists(Ar) Then
  51.                 .Range("G1") = D(2)(Ar)(0)
  52.                 .Range("I1") = D(2)(Ar)(1)
  53.                 D(2).Remove (Ar)
  54.             End If
  55.         End With
  56.         Set Rng = Rng.Offset(1)
  57.     Next
  58.     For Each Ar In D(2).KEYS
  59.         Rng.Copy
  60.         Rng.Offset(1).Insert Shift:=xlDown
  61.         With Rng.Offset(1)
  62.             .SpecialCells(xlCellTypeConstants, 3) = ""
  63.             .Range("A1") = Split(Ar, " ")(1)
  64.             .Range("B1") = Split(Ar, " ")(0)
  65.             .Range("G1") = D(2)(Ar)(0)
  66.             .Range("I1") = D(2)(Ar)(1)
  67.         End With
  68.         Set Rng = Rng.Offset(1)
  69.     Next
  70.     Set Rng = Rng.Offset(-1).CurrentRegion  'CurrentRegion:延伸的範圍
  71.     '********* 排序 :主鍵股票代號
  72.     Rng.Sort Key1:=Rng.Cells(1), Order1:=xlAscending, Header:=xlGuess, _
  73.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
  74.         :=xlStroke, DataOption1:=xlSortNormal
  75. End Sub
  76. End Sub
複製代碼




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