[已解决]求助

GYUHJ

BOOK1.rar (288.53 KB, 下载次数: 8)

2014-2-8 10:09 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

CheryBTL

2014-2-8 10:56

GYUHJ 发表于 2014-2-8 10:34
1,从N列开始,每连续7列的1,3,5,7这4列如果都有相同数,并且这个相同数在(1,3,5,7)每列刚好重复个数都是5个 ...

请测试：

1. Sub test()
   
2.     Dim ar, re, temp
   
3.     Dim i As Integer, j As Integer, Cnt As Integer
   
4.     Dim b As Boolean
   
5.     ar = Sheets(1).Range("N3").CurrentRegion
   
6.     ReDim re(1 To 9999, 1 To 1)
   
7.     For i = 1 To UBound(ar, 2) - 6
   
8.         ReDim temp(3, 999)
   
9.         For j = 1 To UBound(ar)
   
10.             For k = 0 To 3
    
11.                 If ar(j, i + k * 2) <> "" Then
    
12.                     temp(k, Val(ar(j, i + k * 2))) = temp(k, Val(ar(j, i + k * 2))) + 1
    
13.                 End If
    
14.             Next
    
15.         Next
    
16.         For j = 0 To 999
    
17.             b = True
    
18.             For k = 0 To 3
    
19.                 If temp(k, j) <> 5 Then b = False: Exit For
    
20.             Next
    
21.             If b Then
    
22.                 Cnt = Cnt + 1
    
23.                 re(Cnt, 1) = Format(j, "000")
    
24.             End If
    
25.         Next
    
26.     Next
    
27.     Sheets(1).[a1:a65536].ClearContents
    
28.     If Cnt > 0 Then
    
29.         Sheets(1).[a1].Resize(Cnt) = re
    
30.     Else
    
31.         MsgBox "无匹配数据"
    
32.     End If
    
33. End Sub

复制代码

跳转到最佳答案楼层

CheryBTL

有个问题，请楼主再确认下：
1、U列以后的数据怎么处理呢？
2、也就是说，提取在1\3\5\7列中重复5次和4次的数据提取出来，并且是先提取重复5次的，再提取4次的？

GYUHJ

CheryBTL 发表于 2014-2-8 10:20
有个问题，请楼主再确认下：
1、U列以后的数据怎么处理呢？
2、也就是说，提取在1\3\5\7列中重复5次和4次 ...

1,从N列开始,每连续7列的1,3,5,7这4列如果都有相同数,并且这个相同数在(1,3,5,7)每列刚好重复个数都是5个,  

CheryBTL

GYUHJ 发表于 2014-2-8 10:34
1,从N列开始,每连续7列的1,3,5,7这4列如果都有相同数,并且这个相同数在(1,3,5,7)每列刚好重复个数都是5个 ...

请测试：

1. Sub test()
   
2.     Dim ar, re, temp
   
3.     Dim i As Integer, j As Integer, Cnt As Integer
   
4.     Dim b As Boolean
   
5.     ar = Sheets(1).Range("N3").CurrentRegion
   
6.     ReDim re(1 To 9999, 1 To 1)
   
7.     For i = 1 To UBound(ar, 2) - 6
   
8.         ReDim temp(3, 999)
   
9.         For j = 1 To UBound(ar)
   
10.             For k = 0 To 3
    
11.                 If ar(j, i + k * 2) <> "" Then
    
12.                     temp(k, Val(ar(j, i + k * 2))) = temp(k, Val(ar(j, i + k * 2))) + 1
    
13.                 End If
    
14.             Next
    
15.         Next
    
16.         For j = 0 To 999
    
17.             b = True
    
18.             For k = 0 To 3
    
19.                 If temp(k, j) <> 5 Then b = False: Exit For
    
20.             Next
    
21.             If b Then
    
22.                 Cnt = Cnt + 1
    
23.                 re(Cnt, 1) = Format(j, "000")
    
24.             End If
    
25.         Next
    
26.     Next
    
27.     Sheets(1).[a1:a65536].ClearContents
    
28.     If Cnt > 0 Then
    
29.         Sheets(1).[a1].Resize(Cnt) = re
    
30.     Else
    
31.         MsgBox "无匹配数据"
    
32.     End If
    
33. End Sub

复制代码

hetianjun888

学习了