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

jasonwu0114

小學生 Rank: 1

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

論壇贊助勳章

2^#

發表於 2013-12-13 15:45 | 顯示全部帖子

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

小人物

TOP

jasonwu0114

小學生 Rank: 1

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

論壇贊助勳章

3^# 倒序看帖

打印

字體大小: 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無股票代號,要依股票代號順序複製一列插入程式要如何寫???

Sub 轉貼至股權()
'test
Dim bt As Range
Dim rng As Range
Dim s As String
Dim e(1 To 4) As Object
Set e(1) = CreateObject("scripting.dictionary")
Set e(2) = CreateObject("scripting.dictionary")
Set e(3) = CreateObject("scripting.dictionary")
Set e(4) = CreateObject("scripting.dictionary")
Workbooks("部位試算表-麻辣-1030108.xls").Activate
With Sheets("部位表")
For Each bt In Range("a6", .Range("a6").End(xlDown))
With bt
If .Offset(, 4) <> "" Then
If .Offset(, 15) = "交易員1" Then
e(1)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
ElseIf .Offset(, 15).Value = "交易員2" Then
e(2)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
End If
End If
If .Offset(, 7) <> "" Then
If .Offset(, 15) = "交易員1" Then
e(3)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
ElseIf .Offset(, 15).Value = "交易員2" Then
e(4)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
End If
End If
End With
Next
End With
Workbooks("股權投資1030107--麻辣.xls").Activate
With Sheets("交易員1")
Set rng = Sheets("交易員1").Range("a10")
Do While rng <> ""
s = Val(rng)
If e(1).exists(s) Then
.Offset(, 6) = e(1)(s)(0)
.Offset(, 7) = e(1)(s)(1)
End If
If e(3).exists(rng) Then
.Offset(, 8) = e(3)(rng)(0)
.Offset(, 10) = e(3)(rng)(1)
End If
Set rng = rng.Offset(1)
Loop
End With
End Sub

複製代碼

小人物