用VBA行与行循环比较几个数字相同两种方法for each

laoau138

用VBA行与行循环比较几个数字相同两种方法for each

today0427

1. Sub cf()
   
2.     Dim d As Object, i%, j%, ro%, arr, ar(1 To 100), n%, k%
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheet1.Range("c6:h" & Sheet1.[h65536].End(3).Row)
   
5.     For i = 1 To UBound(arr) - 1
   
6.         For j = 1 To UBound(arr, 2)
   
7.             d(arr(i, j)) = ""
   
8.         Next
   
9.         For ro = i + 1 To UBound(arr)
   
10.             For j = 1 To UBound(arr, 2)
    
11.                 If d.exists(arr(ro, j)) Then n = n + 1
    
12.             Next
    
13.             k = k + 1
    
14.             ar(k) = n: n = 0
    
15.         Next
    
16.         d.RemoveAll
    
17.     Next
    
18.     Sheet1.[i9].Resize(k).Clear
    
19.     Sheet1.[i9].Resize(k) = Application.Transpose(ar)
    
20. End Sub

复制代码

today0427

1. Sub bjg()
   
2. Dim i%, j%, ro%, arr, ar(1 To 100), n%, k%, str$
   
3.    
   
4.     arr = Sheet1.Range("c6:h" & Sheet1.[h65536].End(3).Row)
   
5.     For i = 1 To UBound(arr) - 1
   
6.         For j = 1 To UBound(arr, 2)
   
7.             str = str & "," & arr(i, j)
   
8.         Next
   
9.             str = str & ","
   
10.         For ro = i + 1 To UBound(arr)
    
11.             For j = 1 To UBound(arr, 2)
    
12.                 If InStr(str, "," & arr(ro, j) & ",") Then n = n + 1
    
13.             Next
    
14.             k = k + 1
    
15.             ar(k) = n: n = 0
    
16.         Next
    
17.     Next
    
18.     Sheet1.[i9].Resize(k).Clear
    
19.     Sheet1.[i9].Resize(k) = Application.Transpose(ar)
    
20. End Sub

复制代码

laoau138

today0427 发表于 2016-9-29 15:56

这条还没有做
http://www.excelpx.com/thread-424709-1-1.html