Question

** sheet1数据如下;

从11到15的行

栏B 101,102,103,104,105

C列test1，test2，test3，test4，test5

D栏12/1 / 15,12 / 1 / 15,12 / 2 / 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是否是＆gt;然后今天在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

Answer 1

这应该这样做。

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

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

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

1 个答案: