返回列表 上一主題 發帖

[發問] 字典物件KEY的問題

jasonwu0114

帖子
28 
主題
7 
精華
0 
積分
43 
點名
0  
作業系統
windows7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2013-11-8 
最後登錄
2020-4-9 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2014-1-9 17:24 | 只看該作者

[發問] 字典物件KEY的問題

本帖最後由 jasonwu0114 於 2014-1-9 17:25 編輯

我有2個檔案
A(交易總表) 部位試算表-麻辣-1030108.rar (14.77 KB)
B(交易員個人) 股權投資1030107--麻辣.rar (17.26 KB)
想利用字典物件
用股票代號當KEY
將A檔案中有交易內容丟入
e(1):買-交易員1
e(2):買-交易員2
e(3):賣-交易員1
e(4):賣-交易員2

然後啟動B檔案
sheet(交易員1)以現有股票代號當KEY從E1.E3找資料貼上
sheet(交易員2)以現有股票代號當KEY從E2.E4找資料貼上
(假設要貼上的資料在B已經有該檔股票代號)

可是測很久貼不過去
好像是兩邊股票代號的問題
請問
1.哪裡出了問題???
2.程式可以寫的更精簡嗎???
3.如果要貼上的是新標的在B無股票代號,要依股票代號順序複製一列插入程式要如何寫???
  1. Sub 轉貼至股權()
  2. 'test
  3. Dim bt As Range
  4. Dim rng As Range
  5. Dim s As String
  6. Dim e(1 To 4) As Object

  8. Set e(1) = CreateObject("scripting.dictionary")
  9. Set e(2) = CreateObject("scripting.dictionary")
  10. Set e(3) = CreateObject("scripting.dictionary")
  11. Set e(4) = CreateObject("scripting.dictionary")

  13. Workbooks("部位試算表-麻辣-1030108.xls").Activate

  15. With Sheets("部位表")


  18. For Each bt In Range("a6", .Range("a6").End(xlDown))
  19.   With bt
  20.   
  21.    If .Offset(, 4) <> "" Then
  22.          
  23.          If .Offset(, 15) = "交易員1" Then
  24.             
  25.             e(1)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
  26.             
  27.          ElseIf .Offset(, 15).Value = "交易員2" Then
  28.             
  29.             e(2)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
  30.             
  31.          End If
  32.          
  33.    End If
  34.    
  35.    If .Offset(, 7) <> "" Then
  36.    
  37.          If .Offset(, 15) = "交易員1" Then
  38.          
  39.             e(3)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
  40.             
  41.          ElseIf .Offset(, 15).Value = "交易員2" Then
  42.          
  43.             e(4)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
  44.             
  45.          End If
  46.          
  47.    End If
  48.    
  49.   End With
  50. Next

  52. End With


  55. Workbooks("股權投資1030107--麻辣.xls").Activate

  57. With Sheets("交易員1")

  59. Set rng = Sheets("交易員1").Range("a10")

  61.    Do While rng <> ""
  62.    s = Val(rng)
  63.    
  64.          If e(1).exists(s) Then
  65.          
  66.             .Offset(, 6) = e(1)(s)(0)
  67.             .Offset(, 7) = e(1)(s)(1)
  68.          End If
  69.          
  70.          If e(3).exists(rng) Then
  71.             .Offset(, 8) = e(3)(rng)(0)
  72.             .Offset(, 10) = e(3)(rng)(1)
  73.          End If
  74.          
  75.       Set rng = rng.Offset(1)
  76.    Loop
  77.    
  78. End With


  81. End Sub
複製代碼
收藏 分享
小人物

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2014-1-12 07:32 | 只看該作者
本帖最後由 GBKEE 於 2014-1-12 08:01 編輯

回復 1# jasonwu0114
看一下給的注解
  1. Sub 轉貼至股權()
  2. Dim bt As Range
  3. Dim Rng As Range
  4. 'Dim s  As String   '字串
  5. Dim s  As Integer  '數字
  6. Dim e(1 To 4) As Object
  7. Set e(1) = CreateObject("scripting.dictionary")
  8. Set e(2) = CreateObject("scripting.dictionary")
  9. Set e(3) = CreateObject("scripting.dictionary")
  10. Set e(4) = CreateObject("scripting.dictionary")
  11. 'Workbooks("部位試算表-麻辣-1030108.xls").Activate
  12. 'With Sheets("部位表")
  13. With Workbooks("部位試算表-麻辣-1030108.xls").Sheets("部位表")
  14.     For Each bt In .Range("a6", .Range("a6").End(xlDown))
  15.         With bt
  16.             If .Offset(, 4) <> "" Then
  17.                 If .Offset(, 15) = "交易員1" Then
  18.                     e(1)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
  19.                     '**** .Value -> 儲存格是數字  ********
  20.                 ElseIf .Offset(, 15).Value = "交易員2" Then
  21.                     e(2)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
  22.                 End If
  23.             End If
  24.             If .Offset(, 7) <> "" Then
  25.                 If .Offset(, 15) = "交易員1" Then
  26.                     e(3)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
  27.                 ElseIf .Offset(, 15).Value = "交易員2" Then
  28.                     e(4)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
  29.                 End If
  30.             End If
  31.         End With
  32.     Next
  33. End With
  34. Workbooks("股權投資1030107--麻辣.xls").Activate
  35. With Sheets("交易員1")
  36.     Set Rng = .Range("a10")
  37.     Do While Rng <> ""
  38.     's = Val(Rng)
  39.     s = Rng       '儲存格是數字直接引用 (Rng.Value)
  40.          If e(1).exists(s) Then
  41.            Rng.Offset(, 6).Resize(, 2) = e(1)(s)
  42.          End If
  43.          If e(3).exists(Rng.Value) Then   ' Rng是物件, 這裡要給Rng.Value(值)
  44.             Rng.Offset(, 8) = e(3)(Rng.Value)(0)
  45.             Rng.Offset(, 10) = e(3)(Rng.Value)(1)
  46.          End If
  47.       Set Rng = Rng.Offset(1)
  48.    Loop
  49. End With
  50. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jasonwu0114

帖子
28 
主題
7 
精華
0 
積分
43 
點名
0  
作業系統
windows7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2013-11-8 
最後登錄
2020-4-9 

論壇贊助勳章
4#
發表於 2013-12-13 15:45 | 只看該作者
非常非常......感謝
居然是空格的問題
又學到2招
讚
這真是個好地方
小人物

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2013-12-13 14:40 | 只看該作者
回復 1# jasonwu0114
那是因為交易部位的名稱不同所致工作表1的A02110多了一個空白鍵
除了一一寫入的方法，也可一次寫入陣列
你的欄位偏移量應該是5不是8吧?
  1. Sub 債券貼()
  2. Dim rng As Range, rng1 As Range, TP As Range, TP1 As Range
  3. Dim D(1) As Object
  4. Set D(1) = CreateObject("scripting.dictionary")
  5. Sheets("工作表1").Select
  6. With Range("a1:a50")
  7.      Set TP = .Find(what:="交易部位", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
  8. End With
  9. Set rng = TP.Offset(2)
  10. Do While rng <> ""
  11.   With rng
  12.      D(1)(Trim(rng)) = Array(Val(.Offset(, 8)), Val(.Offset(, 9)), Val(.Offset(, 10)), Val(.Offset(, 11)), Val(.Offset(, 12)))
  13.   End With
  14.    Set rng = rng.Offset(1)
  15. Loop
  16. Sheets("債券-已交割部位(台幣)").Select
  17. With Range("a1:a50")
  18.      Set TP1 = .Find(what:="交易部位", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
  19. End With
  20. Set rng1 = TP1.Offset(1)
  21. Do While rng1 <> ""
  22.   With rng1
  23.   If IsArray(D(1)(Trim(rng1))) Then
  24.     '.Offset(, 5).Resize(, 5) = D(1)(Trim(rng1))'一次寫入陣列
  25.     '以下為逐一寫入
  26.     .Offset(, 5) = D(1)(Trim(rng1))(0)
  27.     .Offset(, 6) = D(1)(Trim(rng1))(1)
  28.     .Offset(, 7) = D(1)(Trim(rng1))(2)
  29.     .Offset(, 8) = D(1)(Trim(rng1))(3)
  30.     .Offset(, 9) = D(1)(Trim(rng1))(4)
  31.   End If
  32.   End With
  33.    Set rng1 = rng1.Offset(1)
  34. Loop
  35. End Sub
複製代碼
學海無涯_不恥下問

TOP

jasonwu0114

帖子
28 
主題
7 
精華
0 
積分
43 
點名
0  
作業系統
windows7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2013-11-8 
最後登錄
2020-4-9 

論壇贊助勳章
2#
發表於 2013-12-13 10:24 | 只看該作者

scripting.dictionary使用疑問

請教各位高手
我想把sheet1(工作表1)中部分資料
放入字典物件D(1)  用A欄的債券代碼當KEY
然後依債券代碼
貼入Sheets("債券-已交割部位(台幣)")

可是執行到  .Offset(, 8) = D(1)(rng1.Value)(0)出現錯誤

執行階段錯誤"13"
型態不符合

請問
1.哪裡出問題了??
2.程式可以寫的再簡化一些嗎??

感恩

Sub 債券貼()
Dim rng As Range, rng1 As Range, TP As Range, TP1 As Range
Dim D(1) As Object

Set D(1) = CreateObject("scripting.dictionary")

Sheets("工作表1").Select
With Range("a1:a50")
     Set TP = .Find(what:="交易部位", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
End With
Set rng = TP.Offset(2)
Do While rng <> ""
  With rng
     D(1)(rng.Value) = Array(Val(.Offset(, 8)), Val(.Offset(, 9)), Val(.Offset(, 10)), Val(.Offset(, 11)), Val(.Offset(, 12)))
  
  End With
   Set rng = rng.Offset(1)
Loop

Sheets("債券-已交割部位(台幣)").Select

With Range("a1:a50")
     Set TP1 = .Find(what:="交易部位", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
End With
Set rng1 = TP1.Offset(1)
Do While rng1 <> ""
  With rng1
   .Offset(, 8) = D(1)(rng1.Value)(0)         '這裡出現錯誤
  .Offset(, 9) = D(1)(rng1.Value)(1)
     .Offset(, 10) = D(1)(rng1.Value)(2)
     .Offset(, 11) = D(1)(rng1.Value)(3)
     .Offset(, 12) = D(1)(rng1.Value)(4)
  End With
   Set rng1 = rng1.Offset(1)
Loop

End Sub

債券部位評價.rar (29.87 KB)

小人物

TOP

        靜思自在 : 口說一句好話，如口出蓮花；口說一句壞話如口吐毒蛇。
返回列表 上一主題