求老师解答如何用VBA实现函数公式的功能

woailijiao

求助老师，如何用VBA实现函数的功能，判断两个单元格内的值有重复时输出为文字描述。并快速向下自动计算填充。

详细请查看附件！

woailijiao

怎么没有回复呀？很难吗？

汉唐

不难，你这样问就难了

3190496160

往往玩儿代码的不懂公式，玩儿公式的不懂代码，看不懂你目前的公式，

3190496160

Sub 比对()
With Sheet1
    r = .Cells(Rows.Count, 7).End(xlUp).Row
    ar = .Range("f1:j" & r)
    For i = 7 To UBound(ar)
        If Trim(ar(i, 2)) <> "" Then
            zf_1 = Trim(ar(i, 2))
            gs_1 = Len(zf_1)
            zf_2 = Trim(ar(i - 5, 1))
            gs_2 = Len(zf_2)
            sl = 0
            For j = 1 To gs_1
                For s = 1 To gs_2
                    If Mid(zf_1, j, 1) = Mid(zf_2, s, 1) Then
                        sl = sl + 1
                        Exit For
                    End If
                Next s
            Next j
            If sl > 0 Then
                ar(i, 5) = "第1个单元格有重复数字"
            End If
        End If
    Next i
    .[j1].Resize(UBound(ar), 1) = Application.Index(ar, 0, 5)
End With
MsgBox "ok!"
End Sub

3190496160

代码是猜着写的，仅仅写了J列的代码，供参考，实在是看不懂你目前的公式

准提部林

文字描述自行加加//
Xl0000282.rar (17.15 KB, 下载次数: 7)

2022-12-4 10:11 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr(), crr(), drr()
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Worksheets("sheet1")
   
7.         r = .Cells(.Rows.Count, 6).End(xlUp).Row
   
8.         arr = .Range("f2:g" & r)
   
9.         ReDim brr(1 To UBound(arr), 1 To 2)
   
10.         For i = 1 To UBound(arr)
    
11.             For j = 1 To UBound(arr, 2)
    
12.                 If Len(arr(i, j)) <> 0 Then
    
13.                     ReDim crr(0 To 9)
    
14.                     For k = 1 To Len(arr(i, j))
    
15.                         n = Val(Mid(arr(i, j), k, 1))
    
16.                         crr(n) = 1
    
17.                     Next
    
18.                     brr(i, j) = crr
    
19.                 End If
    
20.             Next
    
21.         Next
    
22.         ReDim drr(1 To UBound(arr), 1 To 5)
    
23.         For i = 6 To UBound(arr)
    
24.             For j = 1 To 5
    
25.                 For k = 0 To 9
    
26.                     If brr(i, 2)(k) = brr(i - (6 - j), 1)(k) And brr(i, 2)(k) = 1 Then
    
27.                         drr(i, j) = "第" & j & "个单元格有重复数字"
    
28.                         Exit For
    
29.                     End If
    
30.                 Next
    
31.             Next
    
32.         Next
    
33.         .Range("p2").Resize(UBound(drr), UBound(drr, 2)) = drr
    
34.     End With
    
35. End Sub
    

复制代码

chxw68

详见附件。

汉唐

楼主请看附件