[已解决]求改动代码

mhjbgf

如果输出结果没有的话为何b1,b2的数据都会清除了
sub test()
    Sheets("1").Select
    On Error Resume Next
    Dim Arr, brr, crr(), d1 As Object, d2 As Object, i As Integer, j, Cnt As Long, c As Collection
    Set d1 = CreateObject("scripting.dictionary")
    For i = 1 To 12
       Arr = Sheets(CStr(i)).Range("L3:DC700").Value
       For Each j In Arr
          d1(i & "|" & j) = d1(i & "|" & j) + 1
       Next
    Next
    Arr = d1.Keys
    brr = d1.Items
    d1.RemoveAll
    Set d2 = CreateObject("scripting.dictionary")
    For i = 0 To UBound(Arr)
       j = Split(Arr(i), "|")(1)
       d1(j & "|" & brr(i)) = d1(j & "|" & brr(i)) + 1
       If d1(j & "|" & brr(i)) > 5 Then d2(j) = ""
    Next
    Range("B3:B" & d2.Count) = Application.Transpose(d2.Keys)
End sub

最佳答案

月排行榜 / 总排行榜

zjdh

2013-12-22 14:04

Range("B65536").End(3)(2).Resize(d2.Count, 1) = Application.Transpose(d2.Keys)

跳转到最佳答案楼层

zjdh

当你没有数据时，d2.Count=0，Range("B3:B" & d2.Count)=Range("B0:B3"),就填上了空值。

zjdh

可在
Range("B3:B" & d2.Count) = Application.Transpose(d2.Keys)
前添加一句
If  d2.Count=0 Then Exit Sub

mhjbgf

zjdh 发表于 2013-12-22 08:11
可在
Range("B3:B" & d2.Count) = Application.Transpose(d2.Keys)
前添加一句

能不能帮我把输岀位置改成b列有数据的下一格开始放,不要固定从b3开始放

zjdh

Range("B65536").End(3)(2).Resize(d2.Count, 1) = Application.Transpose(d2.Keys)