Board logo

標題: [發問] 字典物件KEY的問題 [打印本頁]
作者: jasonwu0114    時間: 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
作者: Hsieh    時間: 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
複製代碼
作者: jasonwu0114    時間: 2013-12-13 15:45

非常非常......感謝
居然是空格的問題
又學到2招
讚
這真是個好地方
作者: jasonwu0114    時間: 2014-1-9 17:24     標題: 字典物件KEY的問題

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

我有2個檔案
A(交易總表)[attach]17229[/attach]
B(交易員個人)[attach]17230[/attach]
想利用字典物件
用股票代號當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    時間: 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
複製代碼




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