Home Articles

Excel VBA:我试图将sheet1中的数据与某些条件与sheet2中的数据进行比较,并仅将不匹配的数据传输到sheet2

Asked
Viewed 1875 times
1

** sheet1数据如下;

从11到15的行

栏B 101,102,103,104,105

C列test1,test2,test3,test4,test5

栏D 12/1 / 15,12 / 1 / 15,12 / 15 / 15,12 / 1 / 15,12 / 1/15

栏E 12/6 / 15,12 / 7 / 15,12 / 2 / 15,11 / 30 / 15,12 / 15/15

sheet2数据如下;

第11行

栏B 101

C列test1

D 12/1/15栏

E 12/6/15栏

我们假设今天是12/5/15 . 我在这里尝试的是,我想看看E11是否>今天在sheet1中,如果是,则将Sheet1中的B11值与sheet2中的B列表进行比较 . 如果值在工作表中的B列中找到,则检查E12并继续 . 如果在工作表中的B列中没有找到该值,那么我想将B11中的B11复制到E11到工作表2中的下一个空行 .

所以代码应该只从sheet1中复制第12行和第15行,然后将它放在第2行和第13行的sheet2中 . 我运行以下代码但是它复制了sheet1中的所有行,如果我再次运行它的每行重复多次 . **

Dim lastrow1 As Long
Dim lastrow2 As Long
Dim erow As Long
Dim name1 As String
Dim name2 As String

lrow1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
lrow2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row

For i = 11 To lrow1
    name1 = Sheets("Sheet1").Cells(i, "C").Value

    For j = 11 To lrow2
        name2 = Sheets("Sheet2").Cells(j, "C").Value

        If Sheets("Sheet1").Cells(i, 5) > Date And name1 <> name2 Then

            Sheets("Sheet1").Activate
            Sheets("Sheet1").Range(Cells(i, "B"), Cells(i, "E")).Copy
            Sheets("Sheet2").Activate
            erow = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
            Sheets("Sheet2").Range(Cells(erow, "B"), Cells(erow, "E")).Select
            ActiveSheet.Paste

        End If

    Next j
    Application.CutCopyMode = False

Next i

1 Answer

  • 2

    这应该做到这一点 .

    Sub cpypste()
    
    Dim lastrow1 As Long
    Dim lastrow2 As Long
    Dim erow As Long
    Dim name1 As String
    Dim name2 As String
    Dim hre As Boolean
    
    lrow1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
    lrow2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
    
    For i = 11 To lrow2
        name1 = Sheets("Sheet1").Cells(i, "C").Value
        hre = False
        For j = 10 To lrow2
            name2 = Sheets("Sheet2").Cells(j, "C").Value
    
            If Sheets("Sheet1").Cells(i, 5) <= Date Or name1 = name2 Then            
                hre = True    
            End If
    
        Next j
        If Not hre Then
            Application.CutCopyMode = False
            Sheets("Sheet1").Range(Sheets("Sheet1").Cells(i, "B"), Sheets("Sheet1").Cells(i, "E")).Copy
            erow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, 2).End(xlUp).Offset(1, 0).Row
            Sheets("Sheet2").Range(Sheets("Sheet2").Cells(erow, "B"), Sheets("Sheet2").Cells(erow, "E")).PasteSpecial
            Sheets("Sheet2").Range("F"&erow).value = "S/O"
        End If
    Next i
    End Sub
    

    问题是你需要在知道行是否存在之前经历完整的第二个循环 .

Related