使用字典统计重复项，运行时出现错误‘13’，类型不匹配

hktk_hrl · 发表于 2011-12-5 10:37

本帖最后由 hktk_hrl 于 2011-12-5 13:37 编辑

需求：有一个表格如下：

Name	Number
A1	p81348318
A2	w55138413
B1	w55553413
D1	m55384381
C3	m88438131

现在想要统计同一Number下的Name，并按照下表的格式给出结果

Number	Name
p81348318	A1
w55138413	A2，B1

也就是将Number相同的Name项汇总到一个单元格内，并用中文逗号隔开。
我自己写了段代码如下：

Sub PreSort()
'
Dim rng As Range
Dim lastR As Integer
Set rng = Sheet1.UsedRange.End(xlDown)
lastR = rng.Row
Number = Sheet1.Range("B2:B" & lastR)
Name = Sheet1.Range("A2:A" & lastR)
Dim d
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Number)
If d.exists(Number(i, 1)) Then
d(Number(i, 1)) = d(Number(i, 1)) & "，" & Name(i, 1)
Else
d(Number(i, 1)) = Name(i, 1)
End If
Next
Sheet2.[A1].Resize(1, 2) = Array("Number", "Name")
Sheet2.[A2].Resize(d.Count, 1) = Application.Transpose(d.keys)
Sheet2.[B2].Resize(d.Count, 1) = Application.Transpose(d.items) '运行到这一句总是出错，提示：运行时错误'13'，类型不匹配
End Sub

复制代码

每次运行到这一句总是出错
[code=vb]Sheet2.[B2].Resize(d.Count, 1) = Application.Transpose(d.items) '运行到这一句总是出错，提示：运行时错误'13'，类型不匹配[/code]
在这一行之前增加断点，然后进入调试，监视d.items的值，应该是正确的，是个一维数组，内容也没错。在论坛里查看其他使用字典统计重复项的例子，将结果写入单元格的部分是一样的，但是我的程序就是一直出错。十分困惑，所以在此求高手指点，感激不尽~

最后附上源文件

Book1.rar (15.13 KB, 下载次数: 75)

YEJINHAI · 发表于 2011-12-5 10:49

这个情况我也经常遇到啊。我也想知道。

香川群子 · 发表于 2011-12-5 10:53

本帖最后由香川群子于 2011-12-5 11:00 编辑

按楼主内容作了个附件，运行结果没有问题啊。

楼主请确认附件。

Book2.zip (8.35 KB, 下载次数: 98)

YEJINHAI · 发表于 2011-12-5 11:08

3楼的正确的，Transpose这个函数经常出问题的。

hktk_hrl · 发表于 2011-12-5 11:10

香川群子发表于 2011-12-5 10:53
按楼主内容作了个附件，运行结果没有问题啊。

你提供的附件我试了，确实没有问题。但是我那个附件一运行就出错啊，麻烦您试下我那个附件，看是否有错？

风云际会6 · 发表于 2011-12-5 12:50

Sub PreSort2()
Dim rng As Range
Dim lastR As Long, i, k, l, arr()
lastR = Sheet1.Range("A65536").End(xlUp).Row
Number = Sheet1.Range("A2:B" & lastR)
ReDim arr(1 To UBound(Number))
Dim d
      Set d = CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(Number)
      k = Number(i, 2)
         If d.exists(k) Then
            d(k) = d(k) & "，" & Number(i, 1)

            arr(l) = d(k)
         Else
            d(k) = Number(i, 1)
            l = l + 1
            arr(l) = d(k)
         End If
      Next
      Sheet2.[A1].Resize(1, 2) = Array("Number", "Name")
      Sheet2.[A2].Resize(d.Count, 1) = Application.Transpose(d.keys)
      For s = 1 To l
      Sheet2.Cells(s + 1, 2) = arr(s)
      Next
End Sub

excelhomeljch · 发表于 2011-12-5 13:13

本帖最后由 excelhomeljch 于 2011-12-5 13:15 编辑

这个错误是因为有item项的字符数超过了256个.

Sub PreSort()
Dim rng As Range
Dim lastR As Integer

Set rng = Sheet1.UsedRange.End(xlDown)
lastR = rng.Row

Number = Sheet1.Range("B2:B" & lastR)
Name = Sheet1.Range("A2:A" & lastR)

Dim d
      Set d = CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(Number)
         If d.exists(Number(i, 1)) Then
            d(Number(i, 1)) = d(Number(i, 1)) & "，" & Name(i, 1)
              If Len(d(Number(i, 1))) >= 256 Then
            d(Number(i, 1)) = ""
            End If
         Else
            d(Number(i, 1)) = Name(i, 1)
         End If
      Next

      Sheet2.[A1].Resize(1, 2) = Array("Number", "Name")
      Sheet2.[A2].Resize(d.Count, 1) = Application.Transpose(d.keys)
      Sheet2.[B2].Resize(d.Count, 1) = Application.Transpose(d.items) '运行到这一句总是出错，提示：运行时错误'13'，类型不匹配

End Sub

香川群子 · 发表于 2011-12-5 13:29

问题找到原因了：

transpose()行列转置函数，对转置时每个单元格内可容纳的字符长度有限制要求。

不得大于250个字符。

……
你的词典结果中，d.keys是不会超过字符长度的，
但d.items结果中，最大字符长度超过250个字符的有269,300,527共3个，
这使得结果无法由transpose函数转置输出。

而在少量数据测试时，当然就不会碰到这个问题啦。

…………
6楼把item结果直接储存到数组arr中，然后逐个输出，所以6楼的代码可以实行。

香川群子 · 发表于 2011-12-5 13:33

hktk_hrl 发表于 2011-12-5 11:10
你提供的附件我试了，确实没有问题。但是我那个附件一运行就出错啊，麻烦您试下我那个附件，看是否有错？

转置函数对每个单元格内可容纳字符要求为不超过250个字符，

你的附件因为数据较多而溢出了。就是这个原因。

excelhomeljch · 发表于 2011-12-5 13:34

香川群子发表于 2011-12-5 13:29
问题找到原因了：

transpose()行列转置函数，对转置时每个单元格内可容纳的字符长度有限制要求。

本人在电脑测试,是不超过256,255个都可以转置

		自动登录	找回密码
密码			免费注册

[已解决] 使用字典统计重复项，运行时出现错误‘13’，类型不匹配