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

hktk_hrl

风云际会6 发表于 2011-12-5 12:50
Sub PreSort2()
    Dim rng As Range
    Dim lastR As Long, i, k, l, arr()

非常感谢，代码可用。

hktk_hrl

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

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

太感谢了，终于明白原因了。

YEJINHAI

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

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

一言惊醒梦中人啊

hktk_hrl

excelhomeljch 发表于 2011-12-5 13:13
这个错误是因为有item项的字符数超过了256个.

Sub PreSort()

Thanks very much。我现在明白了~

香川群子

我也重写了一个代码，
比6楼代码快很多。

因为6楼代码是逐个写入单元格。
而我是数据写入数组后直接输出到单元格。

数据量越大，差异越大。
目前的数据是相差2.8倍。

1. Sub PreSort3()
   
2.         arr = Sheet1.[a1].CurrentRegion
   
3.    
   
4.         Set d = CreateObject("Scripting.Dictionary")
   
5.         For i = 2 To UBound(arr)
   
6.             If d.Exists(arr(i, 2)) Then
   
7.                 d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 1)
   
8.             Else
   
9.                 d(arr(i, 2)) = arr(i, 1)
   
10.             End If
    
11.         Next
    
12.         
    
13.         p = d.keys
    
14.         q = d.items
    
15.         
    
16.         ReDim brr(d.Count, 1)
    
17.         brr(0, 0) = "Number"
    
18.         brr(0, 1) = "Name"
    
19.         
    
20.         For i = 1 To d.Count
    
21.             brr(i, 0) = p(i - 1)
    
22.             brr(i, 1) = q(i - 1)
    
23.         Next
    
24.         
    
25.         Sheet2.[a1].CurrentRegion = ""
    
26.         Sheet2.[a1].Resize(d.Count + 1, 2) = brr
    
27.    
    
28. End Sub
    

复制代码

YEJINHAI

香川群子 发表于 2011-12-5 13:48
我也重写了一个代码，
比6楼代码快很多。

这个比较牛点

YEJINHAI

香川群子 发表于 2011-12-5 13:48
我也重写了一个代码，
比6楼代码快很多。

我觉得这样改一下，是不是更好一些呢？
Sub PreSort4()
Dim arr, brr(), d As Object, k, t, a, i&, j&, m&, l&
Set d = CreateObject("Scripting.Dictionary")
arr = [a1].CurrentRegion
    For i = 2 To UBound(arr)
        If d.Exists(arr(i, 2)) Then
                d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 1)
            Else
                d(arr(i, 2)) = arr(i, 1)
            End If
        Next
        
        p = d.Keys
        q = d.Items
        
        ReDim brr(d.Count, 1)
        brr(0, 0) = "Number"
        brr(0, 1) = "Name"
        
        For i = 1 To d.Count
            brr(i, 0) = p(i - 1)
            brr(i, 1) = q(i - 1)
        Next
[c1].Resize(, 2) = Array("Number", "Name")
[c1].Resize(d.Count + 1, 2) = brr
   
End Sub

hktk_hrl

香川群子 发表于 2011-12-5 13:48
我也重写了一个代码，
比6楼代码快很多。

是的，对数组的操作肯定比对单元格的操作要快。

香川群子

excelhomeljch 发表于 2011-12-5 13:34
本人在电脑测试,是不超过256,255个都可以转置

是的。

1. Sub test()
   
2.     Dim a(0)
   
3.     For i = 1 To 500
   
4.         t = t & "a"
   
5.         a(0) = t
   
6.         On Error GoTo Ext
   
7.         [a1] = WorksheetFunction.Transpose(a)
   
8.     Next
   
9. Ext:
   
10.     MsgBox i
    
11. End Sub
    

复制代码

简单的测试代码，到256时transpose函数溢出。

即，最大可容纳255个字符。

keleccy

香川群子 发表于 2011-12-5 13:48
我也重写了一个代码，
比6楼代码快很多。

又学习了，谢谢！另外，发现用Transpose时，要求数组各维数应规律，不允许某行数据比其他多。