0

我编写了代码来遍历两列，一列是键，另一列是项目/项目。它遍历并找到键，如果找到重复项，则将其与前一个项目一起添加到项目中。当我尝试打印这些项目时，问题就来了。键打印得很好，但这些项目给了我运行时错误“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

错误在 End Sub 之前在线

4

1 回答 1

0

我发现使用 Transpose 时，单元格中最多只能有 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

结束子

于 2013-07-23T17:54:54.320 回答