[已解决]求个vba

oplkj

Book1.rar (81.82 KB, 下载次数: 10)

2016-7-28 11:19 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-7-28 12:02

1. Sub xx()
   
2.     Dim i%, dA, dB, n&, k&
   
3.     Set dA = CreateObject("Scripting.Dictionary")
   
4.     Set dB = CreateObject("Scripting.Dictionary")
   
5.     With Sheet1
   
6.         n = .Cells(.Rows.Count, 6).End(xlUp).Row
   
7.         k = .Cells(.Rows.Count, 8).End(xlUp).Row
   
8.         For i = 5 To n
   
9.             If Not dA.Exists(.Cells(i, 6).Value) Then
   
10.                 dA.Add .Cells(i, 6).Value, 1
    
11.             Else
    
12.                 dA(.Cells(i, 6).Value) = dA(.Cells(i, 6).Value) + 1
    
13.             End If
    
14.         Next
    
15.         For i = 5 To k
    
16.             If Not dB.Exists(.Cells(i, 8).Value) Then
    
17.                 dB(.Cells(i, 8).Value) = 1
    
18.             Else
    
19.                 dB(.Cells(i, 8).Value) = dB(.Cells(i, 8).Value) + 1
    
20.             End If
    
21.         Next
    
22.         i = 0
    
23.         For Each ke In dA.Keys
    
24.             If dA(ke) < dB(ke) - 4 Then
    
25.                 i = i + 1
    
26.                 .Cells(i, 1) = ke
    
27.             End If
    
28.         Next
    
29.     End With
    
30. End Sub

复制代码

跳转到最佳答案楼层

老司机带带我

1. Sub xx()
   
2.     Dim i%, dA, dB, n&, k&
   
3.     Set dA = CreateObject("Scripting.Dictionary")
   
4.     Set dB = CreateObject("Scripting.Dictionary")
   
5.     With Sheet1
   
6.         n = .Cells(.Rows.Count, 6).End(xlUp).Row
   
7.         k = .Cells(.Rows.Count, 8).End(xlUp).Row
   
8.         For i = 5 To n
   
9.             If Not dA.Exists(.Cells(i, 6).Value) Then
   
10.                 dA.Add .Cells(i, 6).Value, 1
    
11.             Else
    
12.                 dA(.Cells(i, 6).Value) = dA(.Cells(i, 6).Value) + 1
    
13.             End If
    
14.         Next
    
15.         For i = 5 To k
    
16.             If Not dB.Exists(.Cells(i, 8).Value) Then
    
17.                 dB(.Cells(i, 8).Value) = 1
    
18.             Else
    
19.                 dB(.Cells(i, 8).Value) = dB(.Cells(i, 8).Value) + 1
    
20.             End If
    
21.         Next
    
22.         i = 0
    
23.         For Each ke In dA.Keys
    
24.             If dA(ke) < dB(ke) - 4 Then
    
25.                 i = i + 1
    
26.                 .Cells(i, 1) = ke
    
27.             End If
    
28.         Next
    
29.     End With
    
30. End Sub

复制代码