[已解决]找相同号码数组

大灰狼1976

附件请测试

1. Private Sub CommandButton1_Click()
   
2. Application.ScreenUpdating = False
   
3. Range("be6:bn" & UsedRange.Rows.Count + 1).ClearContents
   
4. Dim arr, arr1, i&, j As Byte, k&, l&
   
5. arr = [d6].Resize([d65536].End(3).Row - 5, 8)
   
6. l = 6
   
7. For j = 15 To 48 Step 11
   
8.   arr1 = Cells(6, j).Resize(Cells(65536, j).End(3).Row - 5, 8)
   
9.   For k = 1 To UBound(arr1)
   
10.     For i = 1 To UBound(arr)
    
11.       If Join(Application.Index(arr1, k, 0)) = Join(Application.Index(arr, i, 0)) Then
    
12.         Cells(l, 59).Resize(, 8) = Application.Index(arr1, k, 0)
    
13.         Cells(l, 57) = (j - 4) / 11
    
14.         l = l + 1
    
15.       End If
    
16.     Next i
    
17.   Next k
    
18. Next j
    
19. Application.ScreenUpdating = True
    
20. End Sub

复制代码

ping052062

大灰狼1976 发表于 2013-7-9 17:02
附件请测试

非常感谢老师的解答!