[已解决]求2个区域交集的问题

bing507

数据范围.rar (11.09 KB, 下载次数: 16)

2017-7-29 16:07 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-7-31 13:45

给个VBA的吧。

1. Sub aaa()
   
2. Dim i&, k&, r&, arr, brr
   
3. r = Application.Max([b65536].End(3), [e65536].End(3))
   
4. ReDim arr(0 To r, 1 To 2)
   
5. brr = [a1].CurrentRegion
   
6. For i = 1 To UBound(brr)
   
7.   For k = brr(i, 1) To brr(i, 2)
   
8.     arr(k, 1) = 1
   
9.   Next k
   
10. Next i
    
11. brr = [d1].CurrentRegion
    
12. For i = 1 To UBound(brr)
    
13.   For k = brr(i, 1) To brr(i, 2)
    
14.     arr(k, 2) = 1
    
15.   Next k
    
16. Next i
    
17. r = 0
    
18. ReDim brr(1 To 1000, 1 To 2)
    
19. For i = 0 To UBound(arr) - 1
    
20.   If arr(i, 1) = 1 And arr(i, 2) = 1 Then
    
21.     For k = i + 1 To UBound(arr)
    
22.       If arr(k, 1) <> 1 Or arr(k, 2) <> 1 Then Exit For
    
23.     Next k
    
24.     r = r + 1
    
25.     brr(r, 1) = i
    
26.     brr(r, 2) = k - 1
    
27.     i = k
    
28.   End If
    
29. Next i
    
30. [g1].Resize(r, 2) = brr
    
31. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

给个VBA的吧。

1. Sub aaa()
   
2. Dim i&, k&, r&, arr, brr
   
3. r = Application.Max([b65536].End(3), [e65536].End(3))
   
4. ReDim arr(0 To r, 1 To 2)
   
5. brr = [a1].CurrentRegion
   
6. For i = 1 To UBound(brr)
   
7.   For k = brr(i, 1) To brr(i, 2)
   
8.     arr(k, 1) = 1
   
9.   Next k
   
10. Next i
    
11. brr = [d1].CurrentRegion
    
12. For i = 1 To UBound(brr)
    
13.   For k = brr(i, 1) To brr(i, 2)
    
14.     arr(k, 2) = 1
    
15.   Next k
    
16. Next i
    
17. r = 0
    
18. ReDim brr(1 To 1000, 1 To 2)
    
19. For i = 0 To UBound(arr) - 1
    
20.   If arr(i, 1) = 1 And arr(i, 2) = 1 Then
    
21.     For k = i + 1 To UBound(arr)
    
22.       If arr(k, 1) <> 1 Or arr(k, 2) <> 1 Then Exit For
    
23.     Next k
    
24.     r = r + 1
    
25.     brr(r, 1) = i
    
26.     brr(r, 2) = k - 1
    
27.     i = k
    
28.   End If
    
29. Next i
    
30. [g1].Resize(r, 2) = brr
    
31. End Sub

复制代码

bing507

谢谢大神，第12行提示“类型不匹配”。

大灰狼1976

不匹配的原因是不是没有把文字说明部分（合并单元格部分）删除？
如果是其他原因的话请发个出错的附件上来。