首页 文章

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

提问于
浏览 次
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
excel-vba vba excel

1 回答

  • 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

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

    回复于

相关问题