[已解决]用VBA数组for each 行与行循环比较几个数字

laoau138

用VBA数组for each   行与行循环比较几个数字

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-5-24 15:40

1. Sub aaa()
   
2. Dim i&, j&, k&, arr, brr, r&, c
   
3. arr = Range("c6:h" & [c65536].End(3).Row)
   
4. ReDim brr(1 To Application.Combin(UBound(arr), 2), 1 To 1)
   
5. For i = 1 To UBound(arr) - 1
   
6.   For k = i + 1 To UBound(arr)
   
7.     For Each c In Application.Index(arr, i)
   
8.       If Not IsError(Application.Match(c, Application.Index(arr, k), 0)) Then j = j + 1
   
9.     Next c
   
10.     r = r + 1
    
11.     brr(r, 1) = j
    
12.     j = 0
    
13.   Next k
    
14. Next i
    
15. [i9].Resize(UBound(brr)) = brr
    
16. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim i&, j&, k&, arr, brr, r&, c
   
3. arr = Range("c6:h" & [c65536].End(3).Row)
   
4. ReDim brr(1 To Application.Combin(UBound(arr), 2), 1 To 1)
   
5. For i = 1 To UBound(arr) - 1
   
6.   For k = i + 1 To UBound(arr)
   
7.     For Each c In Application.Index(arr, i)
   
8.       If Not IsError(Application.Match(c, Application.Index(arr, k), 0)) Then j = j + 1
   
9.     Next c
   
10.     r = r + 1
    
11.     brr(r, 1) = j
    
12.     j = 0
    
13.   Next k
    
14. Next i
    
15. [i9].Resize(UBound(brr)) = brr
    
16. End Sub

复制代码

laoau138

大灰狼1976 发表于 2017-5-24 15:40

实在太高手了

周义坤

楼上的将VBA跟函数相结合使用,得心应手,在下佩服

1. Sub ek_sky()
   
2. Dim arr As Variant, brr(1 To 10000, 1 To 1) As Variant
   
3. Dim i As Integer, j As Byte, z As Integer, k As Byte
   
4. Dim t As String, L As Byte
   
5.   arr = Range("C6:H" & Cells(Rows.Count, 3).End(xlUp).Row)
   
6.      For i = 1 To UBound(arr) - 1
   
7.             t = ""
   
8.           For j = 1 To UBound(arr, 2)
   
9.             t = t & "," & arr(i, j)
   
10.           Next j
    
11.        For j = i + 1 To UBound(arr)
    
12.           m = m + 1: L = 0
    
13.          For k = 1 To UBound(arr, 2)
    
14.            If t & "," Like "*," & arr(j, k) & ",*" Then
    
15.              L = L + 1
    
16.            End If
    
17.          Next k
    
18.          brr(m, 1) = L
    
19.        Next j
    
20.      Next i
    
21. Range("I9").Resize(k, 1) = brr
    
22. End Sub
    

复制代码

laoau138

周义坤 发表于 2017-5-24 20:40
楼上的将VBA跟函数相结合使用,得心应手,在下佩服

你也是高手

laoau138

大灰狼1976 发表于 2017-5-24 15:40

EXCEL用VBA数组提取到F列


http://www.excelpx.com/thread-430519-1-1.html

大灰狼1976

周义坤 发表于 2017-5-24 20:40
楼上的将VBA跟函数相结合使用,得心应手,在下佩服

过奖了，我只是为了尽量按照用户的要求来写而已，让我自己写估计跟你的思路差不多。