2013-07-09 102 views
0

我已經編寫了代碼來通過兩列,其中一個將是密鑰和其他項目/項目。它會通過並找到關鍵字,如果它找到了重複項,則會將它與前一個項目一起添加到項目中。當我嘗試打印出物品時出現問題。鍵打印出來很好,但項目給我的運行時錯誤'13'類型不匹配。VBA Scripting.Dictionary運行時錯誤'13'類型不匹配

這是代碼。

Sub All() 
Worksheets("All").Activate 
Dim Server As Variant 
Dim Application As Variant 
Dim colLength As Variant 
Dim dict As Object 
Dim element As Variant 
Dim counter As Integer 
Dim env As Variant 
Dim envLength 
Dim com As Variant 
Dim comLength 
Dim kw As Variant 
Dim kwLength 

'copies pair of columns 
env = Range("A3:B" & WorksheetFunction.CountA(Columns(1)) + 1).Value 
com = Range("D3:E" & WorksheetFunction.CountA(Columns(4)) + 1).Value 
kw = Range("G3:H" & WorksheetFunction.CountA(Columns(7)) + 1).Value 
'sets the start or end point of the pasted pair of columns 
envLength = WorksheetFunction.CountA(Columns(1)) + 1 
comLength = envLength + WorksheetFunction.CountA(Columns(4)) + 1 
kwLength = comLength + WorksheetFunction.CountA(Columns(7)) + 1 
'pastes the copies in two big columns 
ActiveSheet.Range("I3:J" & envLength) = env 
ActiveSheet.Range("I" & (envLength) & ":J" & comLength - 3) = com 
ActiveSheet.Range("I" & (comLength - 3) & ":J" & kwLength - 6) = kw 

Set dict = Nothing 
Set dict = CreateObject("scripting.dictionary") 
colLength = WorksheetFunction.CountA(Columns(9)) + 2 
counter = 1 
Application = Range("I3:I" & colLength).Value 
Server = Range("J3:J" & colLength) 
'Generate unique list and count 
For Each element In Server 
    If dict.Exists(element) Then 
     dict.Item(element) = dict.Item(element) & ", " & Application(counter, 1) 
    Else 
     dict.Add element, Application(counter, 1) 
    End If 
    counter = counter + 1 
Next 
Worksheets("All2").Activate 
ActiveSheet.Range("B2:B" & dict.Count + 1).Value = WorksheetFunction.Transpose(dict.keys) 
ActiveSheet.Range("A2:A" & dict.Count + 1).Value = WorksheetFunction.Transpose(dict.items) 
End Sub 

錯誤是在線路末端子

+0

什麼'應用(計數器,1)'做什麼?在立即窗口中嘗試執行這種語句時出現錯誤; '參數數量錯誤或屬性分配無效'。你調試過,以確保你的'dict.Items'實際上包含任何值嗎?聲明另一個變量'Dim testVar as Variant',然後執行'testVar = dict.Items'並在Locals窗口中調試它以確保它不是空的? –

+0

我確認如果我嘗試在空數組上使用'WorksheetFunction.Transpose',我得到一個'13型不匹配'錯誤。 –

+1

我不確定這是問題,但你真的不應該使用應用程序作爲變量名稱,使用保留字作爲變量導致各種各樣的特例 – SWa

回答

0

之前,我發現,當使用移調你只能有最多在小區255個字符。 我通過創建一個變量並將其設置爲等於項目並遍歷每個項目並複製到表單來解決此問題。

Sub Unique() 
Worksheets("All").Activate 
Dim Server As Variant 
Dim App As Variant 
Dim colLength As Variant 
Dim dict As Object 
Dim element As Variant 
Dim counter As Integer 
Dim env As Variant 
Dim envLength 
Dim com As Variant 
Dim comLength 
Dim kw As Variant 
Dim kwLength 
Dim dictItems As Variant 

'copies pair of columns 
env = Range("A3:B" & WorksheetFunction.CountA(Columns(1)) + 1).Value 
com = Range("D3:E" & WorksheetFunction.CountA(Columns(4)) + 1).Value 
kw = Range("G3:H" & WorksheetFunction.CountA(Columns(7)) + 1).Value 
'sets the start or end point of the pasted pair of columns 
envLength = WorksheetFunction.CountA(Columns(1)) + 1 
comLength = envLength + WorksheetFunction.CountA(Columns(4)) + 1 
kwLength = comLength + WorksheetFunction.CountA(Columns(7)) + 1 
'pastes the copies in two big columns 
ActiveSheet.Range("I3:J" & envLength) = env 
ActiveSheet.Range("I" & (envLength) & ":J" & comLength - 3) = com 
ActiveSheet.Range("I" & (comLength - 3) & ":J" & kwLength - 6) = kw 

Set dict = Nothing 
Set dict = CreateObject("scripting.dictionary") 
colLength = WorksheetFunction.CountA(Columns(9)) + 2 
counter = 1 
App = Range("I3:I" & colLength).Value 
Server = Range("J3:J" & colLength).Value 


'Generate unique list of apps and servers 
For Each element In Server 
    If dict.Exists(element) Then 
     If InStr(LCase(dict.item(element)), LCase(App(counter, 1))) = 0 Then 
      dict.item(element) = dict.item(element) & vbLf & App(counter, 1) 
     End If 
    Else 
     dict.Add element, App(counter, 1) 
    End If 
    counter = counter + 1 
Next 

Worksheets("All_Compare").Activate 
ActiveSheet.Range("B2:B" & dict.Count + 1) = WorksheetFunction.Transpose(dict.keys) 
dictItems = dict.items 
For i = 0 To dict.Count - 1 
    Cells(i + 2, 1) = dictItems(i) 
Next 

末次