[已解决]请老师帮助用VBA弄下

excel白兔

wenzili 发表于 2017-4-4 21:55
那就不知道了，我是2010，没有报错

哦 好的 谢谢老师 我明天用公司电脑在看看

wenzili

vaSheet1data = Sheet1.Range("a1").CurrentRegion
vaSheet2data = Sheet2.Range("a1").CurrentRegion
With ThisWorkbook.Sheets("表3")
看这样呢

excel白兔

wenzili 发表于 2017-4-4 22:17
vaSheet1data = Sheet1.Range("a1").CurrentRegion
vaSheet2data = Sheet2.Range("a1").CurrentRegion
Wi ...

谢谢老师辛苦了这么晚了还想，感谢，测试还是一样的中断需调试。我明天再试试高版本的没准就可以了

wenzili

Public Sub master()
Dim vaSheet1data As Variant
Dim vaSheet2data As Variant
Dim lS1Dim1 As Long, lS1Dim2 As Long
Dim lS2Dim1 As Long, lS2Dim2 As Long
Dim iFinded As Integer
Dim i As Long
Dim rng As Range
i = 0
vaSheet1data = Sheet1.Range("a1").CurrentRegion
vaSheet2data = Sheet2.Range("a1").CurrentRegion
With ThisWorkbook.Sheets("表3")
    .Range("a:a").Clear
    .Range("a1").Resize(UBound(vaSheet2data, 1), UBound(vaSheet2data, 2)) = vaSheet2data
    .Range("a1048576").End(xlUp).Select
    For lS1Dim1 = 1 To UBound(vaSheet1data, 1)
        iFinded = 0
        For lS2Dim1 = 1 To UBound(vaSheet2data, 1)
            If Left(vaSheet1data(lS1Dim1, 1), 12) Like Left(vaSheet2data(lS2Dim1, 1), 12) Then
                 iFinded = 1
                 Exit For
            End If
        Next
        If iFinded = 0 Then
                With Selection.Offset(i, 0)
                .Value = vaSheet1data(lS1Dim1, 1)
                .Interior.ColorIndex = 3
        End With
        i = i + 1
        End If
    Next
End With
End Sub
纠错，以此为准

wenzili

excel白兔 发表于 2017-4-4 22:25
谢谢老师辛苦了这么晚了还想，感谢，测试还是一样的中断需调试。我明天再试试高版本的没准就可以了

5楼字典方法，好像更简洁。

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, crr, i&, sh&, d As Object, s$, r&, r1&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets(2).Range("a3:a" & Sheets(2).[a65536].End(3).Row)
   
5. brr = Sheets(1).[a1].CurrentRegion
   
6. ReDim crr(1 To UBound(brr), 1 To 1)
   
7. For i = 2 To UBound(arr)
   
8.   s = Left(Trim(arr(i, 1)), 10)
   
9.   d(s) = ""
   
10. Next i
    
11. For i = 2 To UBound(brr)
    
12.   s = Left(Trim(brr(i, 1)), 10)
    
13.   If Not d.exists(s) Then
    
14.     d(s) = ""
    
15.     r = r + 1
    
16.     brr(r, 1) = brr(i, 1)
    
17.   End If
    
18. Next i
    
19. With Sheets(3)
    
20.   .[a3:a65536].Clear
    
21.   .[a3].Resize(UBound(arr)) = arr
    
22.   r1 = .[a65536].End(3).Row
    
23.   .[a65536].End(3).Offset(1).Resize(r) = brr
    
24.   .Range("a" & r1 + 1 & ":a" & r1 + r).Interior.Color = vbRed
    
25. End With
    
26. End Sub

复制代码