求助FIND SHI使用

owenfsfqb

VBA 新手一名，求助大侠。怎么循环使用FIND.使每个条形码查找是否有重复项，如果有提示FALSE ,没有提示TRUE.谢谢。具体在压缩包中。

owenfsfqb

压缩包7Z中，新建中的是我在找好网上改进的能否还可以优化吗？

jiminyanyan

owenfsfqb 发表于 2018-7-24 17:30
压缩包7Z中，新建中的是我在找好网上改进的能否还可以优化吗？

Sub jimin()
    '　ＶＢＡ　４９４５８５６３９
    Dim arr, d1 As Object, brr(1 To 10000, 1 To 1)
    Set d1 = CreateObject("scripting.dictionary")
    arr = Sheet1.Range("b1:b" & Sheet1.Range("a65535").End(xlUp).Row)
    For i = 2 To UBound(arr)
        d1(arr(i, 1)) = d1(arr(i, 1)) + 1
    Next
    For i = 2 To UBound(arr)
        If d1(arr(i, 1)) = 1 Then
            brr(i, 1) = "FALSE"
        Else
            brr(i, 1) = "TRUE"
          End If
    Next
    Sheet1.Range("p1:fp10000").ClearContents
    Sheet1.Range("p1").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

duquancai

owenfsfqb 发表于 2018-7-24 17:30
压缩包7Z中，新建中的是我在找好网上改进的能否还可以优化吗？

1. Sub main()
   
2.     Dim arr, brr, d As Object, crr(), i As Long
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     brr = Sheets("保存数据").Range("b2:c" & Sheets("保存数据").Cells(Sheets("保存数据").Rows.Count, 2).End(3).Row)
   
5.     If DicMemory(d, brr) = False Then Exit Sub
   
6.     arr = Sheets("扫码区").Range("b2:c" & Sheets("扫码区").Cells(Sheets("扫码区").Rows.Count, 2).End(3).Row)
   
7.     ReDim brr(1 To UBound(arr), 1 To 1)
   
8.     For i = 1 To UBound(arr)
   
9.         If d.exists(arr(i, 1)) Then brr(i, 1) = "FALSE" Else brr(i, 1) = "TRUE"
   
10.     Next
    
11.     Sheets("扫码区").Range("p2").Resize(i - 1) = brr
    
12. End Sub
    
13. Function DicMemory(ByRef o As Object, ByVal q) As Boolean
    
14.     Dim l&, u&, i&
    
15.     l = LBound(q): u = UBound(q)
    
16.     For i = l To u
    
17.         o(q(i, 1)) = vbNullString
    
18.     Next
    
19.     If o.Count > 0 Then DicMemory = True
    
20. End Function

复制代码

lucasmnp

THANK YOUTHANK YOU

owenfsfqb

duquancai 发表于 2018-7-24 22:53

非常感谢 ，是我想要的结果。