求助数据核对ＶＢＡ代码

leefo

各位大虾，附件，sheet1 及sheet2分别为两组数据（原数据量比较大），希望高手帮忙编个代码
条件为：sheet1"工号＂＝sheet2"工号＂
　　　　但对应行中
　　　　sheet1"日期＂在sheets中没有出现
那么此行数据将被选出．
数据请看附件，急！！！急！！！

leefo

忘记了说，其中工号栏是有很多个一样的工号的，我自己写了一个，不过运行起来超慢，受不了啊，大虾救命啊！

LAOMALIN

Sub ronhy()
Dim i&, j&, x&
x = 1
With Sheet1
For i = 2 To .Range("a65536").End(xlUp).Row
For j = 2 To Sheet2.Range("a65536").End(xlUp).Row
If Sheet2.Cells(j, 5) = "" Then
If .Cells(i, 2) = Sheet2.Cells(j, 2) And .Cells(i, 3) = Sheet2.Cells(j, 3) Then
.Cells(i, 5) = "ok" & x
Sheet2.Cells(j, 5) = "ok" & x
x = x + 1
Exit For
End If
End If
Next j
Next i
End With
End Sub

LAOMALIN

我这个是比较普遍的核对方法,你看下合不合适

leefo

唐老师真书,先谢过,我试试看行不行

leefo

刚刚试过,可是不行啊,我要的条件是:
Cells(i, 1) = Sheet2.Cells(j, 1)
但 cells(i,4)<>sheet2.cells(j,4)
时选中数据cells(i,4)所在的行

leefo

我自己写了一个,可以达到目的,就是超慢,有没有高手帮一下啊!!

sub test()   
Dim arr1 As Variant
    Dim arr2 As Variant
    Dim rrow2 As Integer
    Dim i, j, x As Integer
   Dim d As Range
    rrow2 = Range("A65536").End(xlUp).Row
    For j = 1 To rrow2      
        With Worksheets("sheet1").Range("a1:a" & rrow1
        Set d = .Find(arr2(j, 1), LookIn:=xlValues)
        If d Is Nothing Then
        x = x + 1
        Sheets("sheet3").Cells(x, 1) = arr2(j, 1)
        Sheets("sheet3").Cells(x, 2) = arr2(j, 2)
        Sheets("sheet3").Cells(x, 3) = arr2(j, 3)
        Sheets("sheet3").Cells(x, 4) = arr2(j, 4)
        Sheets("sheet3").Cells(x, 6) = "没记录"
   
         End If
       End With
    Next j
end sub

gongzl1981

如果你是用excel 2007的話,可以在vba中用countifs函數
即統計:
sheet1表中每一行記錄,對應工號及日期是否在sheet2中出現.若出現次數為0,就將sheet1中對應數據寫入sheet3中.
但不知速度如何,不過也算是一種解決思路吧.

leefo

谢啦,不过我要是的是VBA代码:)

leefo

我的是03版的