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

jasonwu0114

請教各位高手
我想把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

Hsieh

回復 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

複製代碼

jasonwu0114

非常非常......感謝
居然是空格的問題
又學到2招
讚
這真是個好地方

jasonwu0114

我有2個檔案
A(交易總表) 部位試算表-麻辣-1030108.rar (14.77 KB)

下載次數: 6

2014-1-9 16:18

B(交易員個人) 股權投資1030107--麻辣.rar (17.26 KB)

下載次數: 7

2014-1-9 16:18

想利用字典物件
用股票代號當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
   
7. 
   
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")
    
12. 
    
13. Workbooks("部位試算表-麻辣-1030108.xls").Activate
    
14. 
    
15. With Sheets("部位表")
    
16. 
    
17. 
    
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
    
51. 
    
52. End With
    
53. 
    
54. 
    
55. Workbooks("股權投資1030107--麻辣.xls").Activate
    
56. 
    
57. With Sheets("交易員1")
    
58. 
    
59. Set rng = Sheets("交易員1").Range("a10")
    
60. 
    
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
    
79. 
    
80. 
    
81. End Sub

複製代碼

GBKEE

回復 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

複製代碼