[已解决]请哪位高手帮助修改代码

ymq123

请哪位高手帮助修改代码，说明详见附件。谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-2 13:18

1. Private Sub CommandButton1_Click()
   
2.     Dim i%, j%, k%, str$, arr, d As Object, x As Integer
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For x = 0 To 1
   
5.         For i = 2 To 6
   
6.             For j = 1 To 8
   
7.                 str = str & Cells(i + 12 * x, j) & ","
   
8.             Next
   
9.             d(str) = ""
   
10.             str = ""
    
11.         Next
    
12.         k = 0
    
13.         For i = 8 To 12
    
14.             For j = 1 To 8
    
15.                 str = str & Cells(i + 12 * x, j) & ","
    
16.             Next
    
17.             If Not d.Exists(str) Then
    
18.                 k = k + 1
    
19.                 Cells(k + 7 + 12 * x, 11).Resize(1, 8) = Cells(i + 12 * x, 1).Resize(1, 8).Value
    
20.             Else
    
21.                 d.Remove str
    
22.             End If
    
23.             str = ""
    
24.         Next
    
25.         arr = d.Keys
    
26.         For i = 0 To UBound(arr)
    
27.             Debug.Print i + 2 + 12 * x, 11
    
28.             Cells(i + 2 + 12 * x, 11).Resize(1, 8) = Split(arr(i), ",")
    
29.         Next
    
30.         d.RemoveAll
    
31.     Next x
    
32. 
    
33. End Sub

复制代码

字典没清空。

跳转到最佳答案楼层

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim i%, j%, k%, str$, arr, d As Object, x As Integer
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For x = 0 To 1
   
5.         For i = 2 To 6
   
6.             For j = 1 To 8
   
7.                 str = str & Cells(i + 12 * x, j) & ","
   
8.             Next
   
9.             d(str) = ""
   
10.             str = ""
    
11.         Next
    
12.         k = 0
    
13.         For i = 8 To 12
    
14.             For j = 1 To 8
    
15.                 str = str & Cells(i + 12 * x, j) & ","
    
16.             Next
    
17.             If Not d.Exists(str) Then
    
18.                 k = k + 1
    
19.                 Cells(k + 7 + 12 * x, 11).Resize(1, 8) = Cells(i + 12 * x, 1).Resize(1, 8).Value
    
20.             Else
    
21.                 d.Remove str
    
22.             End If
    
23.             str = ""
    
24.         Next
    
25.         arr = d.Keys
    
26.         For i = 0 To UBound(arr)
    
27.             Debug.Print i + 2 + 12 * x, 11
    
28.             Cells(i + 2 + 12 * x, 11).Resize(1, 8) = Split(arr(i), ",")
    
29.         Next
    
30.         d.RemoveAll
    
31.     Next x
    
32. 
    
33. End Sub

复制代码

字典没清空。

hwc2ycy

运行的时候，如果显示有误，先把原来的表3-8内容清除，再过行就好了。