[已解决]请老师改下代码？

hadha

请老师改下代码？

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-4-12 23:53

把 Range(rng.Address) = y & "。"
改为
If Len(y) Then Range(rng.Address) = y & "。"
避免多余的。

跳转到最佳答案楼层

hwc2ycy

代码应用时有个输入对话框，选哪的数据来会出现你说的结果。

hwc2ycy

把 Range(rng.Address) = y & "。"
改为
If Len(y) Then Range(rng.Address) = y & "。"
避免多余的。

fdsaa

hwc2ycy 发表于 2014-4-12 23:53
把 Range(rng.Address) = y & "。"
改为
If Len(y) Then Range(rng.Address) = y & "。"

这样写行不行？

hwc2ycy

另外为啥要用这种range(rng.address)来操作呢？
rng直接写入不成？

hadha

hwc2ycy 发表于 2014-4-13 00:15
另外为啥要用这种range(rng.address)来操作呢？
rng直接写入不成？

那张表的位置不太确定，还有怎么让k=0

hwc2ycy

hadha 发表于 2014-4-13 10:18
那张表的位置不太确定，还有怎么让k=0

k是代码中统计用的。

hadha

hwc2ycy 发表于 2014-4-13 10:36
k是代码中统计用的。

s列无数据，代码执行后为空，怎么让k=0

hwc2ycy

hadha 发表于 2014-4-13 10:45
s列无数据，代码执行后为空，怎么让k=0

你把K声明为整形，这样默认值就是0了。

1. Sub abc()
   
2.     Dim d As Object, dic As Object, rng As Range
   
3.     Dim k%, j%, l%, y$, m$
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.     arr = Range("g5:ag" & Range("g65536").End(xlUp).Row)
   
7.     ReDim brr(1 To UBound(arr), 1 To 3)
   
8.     For i = 1 To UBound(arr)
   
9.         If Len(arr(i, 13)) Then
   
10.             s = "(" & arr(i, 1) & "-" & arr(i, 2) & "-" & arr(i, 3) & ")"
    
11.             If Not d.Exists(s) Then
    
12.                 d(s) = d.Count + 1
    
13.                 brr(d(s), 1) = s
    
14.             End If
    
15.             brr(d(s), 2) = brr(d(s), 2) + 1
    
16.             dic(s & "|" & arr(i, 13)) = dic(s & "|" & arr(i, 13)) + 1
    
17.             k = k + 1: l = l + arr(i, 4)
    
18.         End If
    
19.         j = j + 1
    
20.     Next
    
21.     For Each tmp In dic.keys
    
22.         artmp = Split(tmp, "|")
    
23.         brr(d(artmp(0)), 3) = brr(d(artmp(0)), 3) & "," & dic(tmp) & "|" & artmp(1)
    
24.     Next
    
25.     s = ""
    
26.     For i = 1 To d.Count
    
27.         If brr(i, 2) = Val(Mid(brr(i, 3), 2)) Then
    
28.             s = s & "；" & brr(i, 2) & "|" & brr(i, 1) & Split(brr(i, 3), "|")(1)
    
29.         Else
    
30.             s = s & "；" & brr(i, 2) & "|" & brr(i, 1) & ":" & Mid(brr(i, 3), 2)
    
31.         End If
    
32.     Next
    
33.     y = Mid(Replace(s, "|", "个"), 2)
    
34.     d.RemoveAll
    
35.     crr = Range("z5:z" & Range("g65536").End(xlUp).Row)
    
36.     For i = 1 To UBound(crr)
    
37.         If Len(crr(i, 1)) Then d(crr(i, 1)) = ""
    
38.     Next
    
39.     m = Join(d.keys, "/")
    
40.     Application.DisplayAlerts = False
    
41.     Workbooks.Open Filename:=ThisWorkbook.Path & "\分表.xls"
    
42.     On Error Resume Next
    
43.     Set rng = Application.InputBox("请选择：", , "$E$10", Type:=8)
    
44.     If Len(y) Then y = y & "。"
    
45.     Range(rng.Address) = y
    
46.     Range(rng.Address).Offset(, -2) = j
    
47.     Range(rng.Address).Offset(, -1) = k
    
48.     Range(rng.Address).Offset(, 1) = l
    
49.     Range(rng.Address).Offset(, 2) = m
    
50.     Application.DisplayAlerts = True
    
51. End Sub

复制代码

hwc2ycy

楼主，尽量养成变量先声明再使用的习惯比较好。