求计算出符合要求的数的个数的代码

159720

Book2.zip (12.92 KB, 下载次数: 13)

2013-5-14 22:25 上传

点击文件名下载附件

qy1219no2

……………………………………………………见5楼结果

grf1973

1. Sub tt()  '以第9行为例
   
2.     For j = 1 To 999
   
3.         xstr = Format(j, "000"): xsum = 0   'xsum是判断函数，当xsum=6时满足条件
   
4.         a = Left(xstr, 1): b = Mid(xstr, 2, 1): c = Right(xstr, 1)   '分离各位为a,b,c
   
5.         For i = 1 To 6
   
6.             mstr = Cells(9, i)   '第9行的1--6列
   
7.             If InStr(mstr, a) > 0 Or InStr(mstr, b) > 0 Or InStr(mstr, c) > 0 Then
   
8.                 xsum = xsum + 1
   
9.             Else
   
10.                 Exit For
    
11.             End If
    
12.         Next
    
13.         If xsum = 6 Then n = n + 1: Debug.Print xstr
    
14.     Next
    
15.     Debug.Print n
    
16. End Sub
    

复制代码

grf1973

1. Sub tt1()   '对[a1:f9]
   
2.     arr = [a1].CurrentRegion
   
3.     Columns("H").ClearContents
   
4.     For k = 1 To UBound(arr)
   
5.         n = 0
   
6.         For j = 1 To 999
   
7.             xstr = Format(j, "000"): xsum = 0   'xsum是判断函数，当xsum=6时满足条件
   
8.             a = Left(xstr, 1): b = Mid(xstr, 2, 1): c = Right(xstr, 1)   '分离各位为a,b,c
   
9.             For i = 1 To UBound(arr, 2)
   
10.                 mstr = arr(k, i)   '第k行的1--6列
    
11.                 If InStr(mstr, a) > 0 Or InStr(mstr, b) > 0 Or InStr(mstr, c) > 0 Then
    
12.                     xsum = xsum + 1
    
13.                 Else
    
14.                     Exit For
    
15.                 End If
    
16.             Next
    
17.             If xsum = UBound(arr, 2) Then n = n + 1
    
18.         Next
    
19.         Cells(k, "H") = n
    
20.     Next
    
21. End Sub

复制代码

qy1219no2

按ALT+F11，执行主菜单“插入——模块”，将下述代码粘贴到右侧编辑区，退出代码编辑器。在H1单元格输入
=nNum(A1:F1,0,999,3)
下拉复制公式即可得到正确结果
自定义函数说明：
nNum(查找区域,数值最小值,数值最大值,数值位数)
比如：nNum(A1:F1,0,999,3)就表示在A1：F1单元格中的数字查找000—999都包含的个数。

1. Function nNum(Arg As Range, nMin%, nMax%, nLen%) As Integer
   
2.     Dim n%, i%, k%, j%, m%, c As String
   
3.     For i = 0 To nMax - nMin
   
4.        c = Format(i, String(nLen, "0"))
   
5.        For k = 1 To Arg.Count
   
6.             m = 0
   
7.             For j = 1 To Len(Arg(k))
   
8.                 If InStr(c, Mid(Arg(k), j, 1)) > 0 Then m = m + 1
   
9.             Next
   
10.             If m = 0 Then n = n + 1: Exit For
    
11.         Next
    
12.     Next
    
13.     nNum = nMax - nMin + 1 - n
    
14. End Function

复制代码

dsmch

1. Function aa(m, n)
   
2. For i = 1 To Len(m)
   
3.     If InStr(n, Mid(m, i, 1)) Then aa = 1: Exit Function
   
4. Next
   
5. End Function
   
6. Sub Macro1()
   
7. Dim arr, brr, crr, i&, j&, k&, s2%, s%
   
8. arr = Range("a1:f" & Range("a65536").End(xlUp).Row)
   
9. brr = [g1:g1000]
   
10. ReDim crr(1 To UBound(arr), 1 To 1)
    
11. For i = 1 To UBound(arr)
    
12.     s = 0
    
13.     For k = 1 To UBound(brr)
    
14.         m = brr(k, 1): s2 = 0
    
15.         For j = 1 To UBound(arr, 2)
    
16.             n = arr(i, j)
    
17.             If aa(m, n) > 0 Then s2 = s2 + 1
    
18.         Next
    
19.         If s2 = 6 Then s = s + 1
    
20.     Next
    
21.     crr(i, 1) = s
    
22. Next
    
23. Range("h1").Resize(UBound(crr), 1) = crr
    
24. End Sub
    
25. 
    

复制代码

159720

qy1219no2 发表于 2013-5-15 15:47
按ALT+F11，执行主菜单“插入——模块”，将下述代码粘贴到右侧编辑区，退出代码编辑器。在H1单元格输入
= ...

太厉害了，非常感谢你！

159720

grf1973 发表于 2013-5-15 10:19

非常感谢你