[已解决]求个VBA

lkjhuy

Book1.rar (5.8 KB, 下载次数: 7)

2013-12-2 20:29 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

yyyydddd8888

2013-12-2 21:01

请测试：
Book1.zip (9.23 KB, 下载次数: 1)

2013-12-2 21:02 上传

点击文件名下载附件

1. Sub 判断()
   
2. Dim i%, j%, str$, st$, arr, brr(1 To 4)
   
3. arr = Range("d5:g5")
   
4. str = Range("a1")
   
5. For i = 1 To UBound(arr, 2)
   
6.    st = arr(1, i)
   
7.     For j = 1 To Len(st)
   
8.         If InStr(str, Mid(st, j, 1)) Then
   
9.            k = k + 1
   
10.            brr(i) = 1
    
11.         End If
    
12.     Next j
    
13.         If k = 0 Then brr(i) = 0
    
14.     k = 0
    
15.     st = ""
    
16. Next i
    
17.     Range("d3").Resize(1, 4) = brr
    
18. End Sub
    

复制代码

跳转到最佳答案楼层

yyyydddd8888

请测试：
Book1.zip (9.23 KB, 下载次数: 1)

2013-12-2 21:02 上传

点击文件名下载附件

1. Sub 判断()
   
2. Dim i%, j%, str$, st$, arr, brr(1 To 4)
   
3. arr = Range("d5:g5")
   
4. str = Range("a1")
   
5. For i = 1 To UBound(arr, 2)
   
6.    st = arr(1, i)
   
7.     For j = 1 To Len(st)
   
8.         If InStr(str, Mid(st, j, 1)) Then
   
9.            k = k + 1
   
10.            brr(i) = 1
    
11.         End If
    
12.     Next j
    
13.         If k = 0 Then brr(i) = 0
    
14.     k = 0
    
15.     st = ""
    
16. Next i
    
17.     Range("d3").Resize(1, 4) = brr
    
18. End Sub
    

复制代码

爱疯

2楼可以简化为

Sub 判断()
    Dim i%, j%, x$, y, arr, brr(1 To 4) As Integer
    arr = Range("d5:g5")
    x = Range("a1")
    For i = 1 To UBound(arr, 2)
        y = arr(1, i)
        For j = 1 To Len(y)
            If InStr(x, Mid(y, j, 1)) Then brr(i) = 1: Exit For
        Next j
    Next i
    Range("i3").Resize(1, 4) = brr
End Sub

爱疯

一开始忘了去想instr

Sub test()
    Dim A(), j%, x%, y%
    x = [a1]
    A = [D3:g5].Value
   
    For j = 1 To UBound(A, 2)
        y = A(3, j)
        A(1, j) = IIf(zh(x) + zh(y) <> zh(x & y), 1, 0)
    Next j
    [d3].Resize(UBound(A), UBound(A, 2)) = A
End Sub

Function zh(str)    '去重复数字后的长度
    Dim i, t, B(9)
    For i = 1 To Len(str)
        t = Mid(str, i, 1)
        B(t) = t
    Next i
    zh = Len(Join(B, ""))
End Function

lkjhuy

yyyydddd8888 发表于 2013-12-2 21:01
请测试：

数据D5:G5不是固定的,后面有时要到BB5,能否改下