[已解决]求助

gmshe58

请同学们帮助。 求助.rar (5.83 KB, 下载次数: 28)

2012-4-10 17:30 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

suwenkai

2012-4-12 10:39

1. Sub 测试()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. With Sheet1
   
4.     r = .Range("a65536").End(xlUp).Row
   
5.     arr = .Range("a3:af" & r)
   
6.     brr = .Range("c35:af36")
   
7.     ReDim crr(1 To UBound(arr) * UBound(arr, 2), 1 To 6)
   
8.     For a = 1 To UBound(arr)
   
9.         For b = 4 To UBound(arr, 2) Step 8
   
10.             s = arr(a, b - 1)
    
11.             If Not d.exists(s) Then
    
12.                 n = n + 1
    
13.                 d(s) = n
    
14.                 For c = 1 To 6
    
15.                     crr(n, c) = arr(a, c + b - 2)
    
16.                 Next
    
17.             Else
    
18.                 For c = 2 To 6
    
19.                     crr(d(s), c) = crr(d(s), c) + arr(a, c + b - 2)
    
20.                 Next
    
21.             
    
22.             End If
    
23.         Next
    
24.     Next
    
25.     For a = 1 To 2
    
26.         For b = 1 To 30 Step 8
    
27.             s = brr(a, b)
    
28.             If Len(s) Then
    
29.                 For c = 1 To 5
    
30.                     brr(a, b + c) = crr(d(s), c + 1)
    
31.                 Next
    
32.             End If
    
33.         Next
    
34.     Next
    
35.     .Range("c35:af36") = brr
    
36. End With
    
37. End Sub

复制代码

跳转到最佳答案楼层

砂海

求助.rar (6.12 KB, 下载次数: 9)

2012-4-10 18:03 上传

点击文件名下载附件
用的函数。{:011:}

szczm121

用代码没函数简洁，至少我写出来比较繁琐。 求助(解).rar (12.72 KB, 下载次数: 7)

2012-4-10 22:04 上传

点击文件名下载附件

gmshe58

szczm121 发表于 2012-4-10 22:04
用代码没函数简洁，至少我写出来比较繁琐。

谢谢。答案正确，太复杂了。谢谢你的辛勤帮助。
用数组会好一些。我不会。
能用循环的话，我想也会简洁一些。

gmshe58

砂海 发表于 2012-4-10 18:04
用的函数。

我看懂了。但是，我们的操作人员不会、不懂，我想用宏加上按钮。谢谢你的帮助。期待更好的结果。

wangchangjun

gmshe58 发表于 2012-4-11 08:30
我看懂了。但是，我们的操作人员不会、不懂，我想用宏加上按钮。谢谢你的帮助。期待更好的结果。

用字典可能简洁些。

gmshe58

wangchangjun 发表于 2012-4-11 09:52
用字典可能简洁些。

非常期待中，老弟你写代码吧。

suwenkai

1. Sub 测试()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. With Sheet1
   
4.     r = .Range("a65536").End(xlUp).Row
   
5.     arr = .Range("a3:af" & r)
   
6.     brr = .Range("c35:af36")
   
7.     ReDim crr(1 To UBound(arr) * UBound(arr, 2), 1 To 6)
   
8.     For a = 1 To UBound(arr)
   
9.         For b = 4 To UBound(arr, 2) Step 8
   
10.             s = arr(a, b - 1)
    
11.             If Not d.exists(s) Then
    
12.                 n = n + 1
    
13.                 d(s) = n
    
14.                 For c = 1 To 6
    
15.                     crr(n, c) = arr(a, c + b - 2)
    
16.                 Next
    
17.             Else
    
18.                 For c = 2 To 6
    
19.                     crr(d(s), c) = crr(d(s), c) + arr(a, c + b - 2)
    
20.                 Next
    
21.             
    
22.             End If
    
23.         Next
    
24.     Next
    
25.     For a = 1 To 2
    
26.         For b = 1 To 30 Step 8
    
27.             s = brr(a, b)
    
28.             If Len(s) Then
    
29.                 For c = 1 To 5
    
30.                     brr(a, b + c) = crr(d(s), c + 1)
    
31.                 Next
    
32.             End If
    
33.         Next
    
34.     Next
    
35.     .Range("c35:af36") = brr
    
36. End With
    
37. End Sub

复制代码

2288liu

看不懂                        不过支持

LIYEHUAOK

厉害