Excel VBA:我试图将具有某些条件的书籍之间的数据与数据进行比较,并仅传输不匹配的数据第二本书

时间:2015-12-07 18:26:43

标签: excel excel-vba vba

book1pheet1数据如下;

Rows: from 11 to 17
Column B: 101, 102, 103, 104, 105, 106, 107
Column C: test1, test2, test3, test4, test5, test6, test7
Column D: 12/1/15, 12/2/15, 12/3/15, 12/4/15, 12/5/15, 12/6/15, 12/7/15
Column E: 12/7/15, 12/7/15, 12/8/15, 12/10/15, 12/2/15, 11/30/15, 12/15/15

J11: $45.00
J16: $90.00
K12: $50.00, K13: $100.00, K14: $45.0C
L15: $50.00
M14: $45.00, M17: $250.00

book2pheet1数据应如下;

Row: 4 to 7
Column A: 12/2/15, 12/3/15, 12/4/15, 12/7/15
Column B: 12/7/15, 12/8/15, 12/10/15, 12/15/15
Column C: test2, test3, test4, test7
Column H: 102, 103, 104, 107
Column I: $50.00, $100.00, $90.00, $250.00

我在这里尝试的是,我想知道“K11”或“M11”是否是>然后在book1 / sheet1中为$ 0,如果是,则将book1 / sheet1中的“C11”和“E11”的值与book2 / sheet1中的C列和B列的列表进行比较。如果book2 / sheet1中的C列和B列中的两个值相同,则检查book1 / sheet1中的E12并继续。如果值在book2 / sheet1中的C列和B列中不匹配,那么我想将D11复制到A4,E11到B4,C11到C4,K11& M11到I4和B11到H4从book1 / sheet1到book2 / sheet1并继续在book2 / sheet1中的下一个空行。

所以代码应该只从book1 / sheet1获取第12行到第14行和第17行的数据,然后将它放在第2行到第7行的book2 / sheet1中。我运行以下代码,但不复制任何内容。

Sub test5()
Dim lrow1 As Long
Dim lrow2 As Long
Dim erow As Long
Dim name1 As String
Dim name2 As String
Dim mydate1 As Date
Dim mydate2 As Date
Dim check As Boolean

Workbooks.Open Filename:="C:\Users\tp142d\Documents\Book2.xlsx"

lrow1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
lrow1 = Workbooks("Book2").Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

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

    For j = 3 To lrow2
        name2 = Workbooks("Book2").Sheets("Sheet1").Cells(j, "C").Value
        mydate2 = Workbooks("Book2").Sheets("Sheet1").Cells(j, "B").Value

        If Sheets("Sheet1").Cells(i, "K") > 0 And Sheets("Sheet1").Cells(i, "M") > 0 And name1 <> name2 And mydate1 <> mydate2 Then
            check = True
        End If

    Next j

    If Not check Then
        Sheets("Sheet1").Cells(i, "D").Copy
        erow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Workbooks("Book1").Sheets("sheet1").Cells(erow, "A").PasteSpecial

        Sheets("Sheet1").Cells(i, "E").Copy
        Workbooks("Book2").Sheets("Sheet1").Cells(erow, "B").PasteSpecial

        Sheets("Sheet1").Cells(i, "C").Copy
        Workbooks("Book2").Sheets("Sheet1").Cells(erow, "C").PasteSpecial

        Sheets("Sheet1").Cells(i, "B").Copy
        Workbooks("Book2").Sheets("Sheet1").Cells(erow, "H").PasteSpecial

        Sheets("Sheet1").Cells(i, "K").Copy
        Workbooks("Book2").Sheets("Sheet1").Cells(erow, "I").PasteSpecial

    ActiveWorkbook.Save

    End If

Next i

End Sub

2 个答案:

答案 0 :(得分:1)

线索在您的标题中:比较两个工作簿之间的数据

您的代码正在比较同一工作簿上的所有不同单元格。原因是您没有明确地引用 Book1 对象,如果没有明确的WorkBook对象,VBA将采用ActiveWorkBook。当您打开WorkBook(例如,Workbooks.Open Filename:="C:\Users\tp142d\Documents\Book2.xlsx")时,它会变为ActiveWorkbook

我担心您将 Book2 中的数据与 Book2 中的...数据进行比较。

为了防止这种情况,这些行

name1 = Sheets("Sheet1").Cells(i, "C").Value

需要包含WorkBook对象,如下所示:

name1 = WorkBooks("Book1").Sheets("Sheet1").Cells(i, "C").Value

更容易设置两个WorkBook个对象变量 - 更容易输入,更容易智能感知,更容易阅读。我也对Sheet名称做了同样的事情。使用命名协议,一些示例代码如下所示:

Dim wb1 As WorkBook
Dim wb2 As WorkBook
Dim ws1 As WorkSheet
Dim ws2 As WorkSheet

'Define your workbooks
Set wb1 = WorkBooks("Book1")
Set wb2 = WorkBooks.Open Filename:="C:\Users\tp142d\Documents\Book2.xlsx"

'Define your worksheets
Set ws1 = wb1.WorkSheets("Sheet1")
Set ws2 = wb2.WorkSheets("Sheet1")

'Sample useage
name1 = ws1.Cells(i, "C").Value
name2 = ws2.Cells(j, "C").Value

即使我只打开一个WorkBook,我的个人规则也始终包含WorkSheetWorkbook个对象。您所需要的只是让用户激活不同的工作簿或不同的工作表而您失去了对代码的控制权 - 而像Cells.Clear这样的东西肯定会让您失去用户的圣诞贺卡清单。如果您要在两个工作簿或工作表之间比较数据,那么这是必须的。

顺便说一句,我怀疑这一行是一个错字:

lrow1 = Workbooks("Book2").Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

不应该是:

lrow2 = Workbooks("Book2").Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

答案 1 :(得分:0)

首先,你真的需要了解@Ambie在他的回答中所说的内容,因为它会帮助你看到你的副本和粘贴版本。

此代码应该按您的要求执行:

    Sub test5()
Dim lrow1 As Long
Dim lrow2 As Long
Dim erow As Long
Dim name1 As Variant
Dim name2 As Variant
Dim mydate1 As Variant
Dim mydate2 As Variant
Dim check As Boolean
Dim ows As Worksheet
Dim tws As Worksheet
Dim owb As Workbook
Dim twb As Workbook
Dim check2 As Boolean

Set owb = ActiveWorkbook
Set twb = ActiveWorkbook 'Workbooks.Open(Filename:="C:\Users\tp142d\Documents\Book2.xlsx")

Set ows = owb.Sheets("Sheet21")
Set tws = twb.Sheets("Sheet28")

lrow1 = ows.Range("B" & Rows.Count).End(xlUp).Row
lrow2 = tws.Range("A" & Rows.Count).End(xlUp).Row

For i = 11 To lrow1

    name1 = ows.Cells(i, "C").Value
    mydate1 = ows.Cells(i, "E").Value
    check = False
    check2 = False
    If ows.Cells(i, "K") > 0 Or ows.Cells(i, "M") > 0 Then
        check2 = True
        For j = 3 To lrow2
            name2 = tws.Cells(j, "C").Value
            mydate2 = tws.Cells(j, "B").Value

            If name1 = name2 And mydate1 = mydate2 Then
                check = True
                Exit For
            End If

        Next j
    End If
    If Not check And check2 Then
        erow = tws.Cells(tws.Rows.Count, 1).End(xlUp).offset(1, 0).Row
        tws.Cells(erow, "A").Value = ows.Cells(i, "D").Value
        tws.Cells(erow, "B").Value = ows.Cells(i, "E").Value
        tws.Cells(erow, "C").Value = ows.Cells(i, "C").Value
        tws.Cells(erow, "H").Value = ows.Cells(i, "B").Value
        tws.Cells(erow, "I").Value = ows.Cells(i, "K").Value + ows.Cells(i, "M").Value


   ' twb.Save

    End If

接下来我

End Sub