需要比较2个excel表并创建报告

时间:2015-06-16 07:54:26

标签: excel vba excel-vba

我有2张Excel工作表,我需要在工作表1中取1个值,在工作表2中查找它。如果我找到它,那么我需要确保其他一些值匹配。如果是,我将在“匹配”选项卡中复制工作表1行。

如果没有,我会在“不匹配”标签中复制该行,我需要插入一条消息,说明哪个值不匹配。

我现在无法让它发挥作用。我想我不是在正确的地方退出循环。这是我的代码。如果有人可以提供帮助,我将不胜感激。

Sub compareAndCopy()

Dim LastRowISINGB As Integer
Dim LastRowISINNR As Integer
Dim lastRowM As Integer
Dim lastRowN As Integer
Dim foundTrue As Boolean
Dim ErrorMsg As String

' stop screen from updating to speed things up
Application.ScreenUpdating = False

'Find the last row for column F and Column B from Sheet 1 and Sheet 2

LastRowISINGB = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "f").End(xlUp).row
LastRowISINNR = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "b").End(xlUp).row

'fIND THE LAST ROW OF MATCH AND MISMATCH TAB
lastRowM = Sheets("mismatch").Cells(Sheets("mismatch").Rows.Count, "f").End(xlUp).row + 1
lastRowN = Sheets("match").Cells(Sheets("match").Rows.Count, "f").End(xlUp).row + 1

'ISIN MATCH FIRST

For I = 2 To LastRowISINGB

    For J = LastRowISINNR To 2 Step -1

                If Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
                    Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
                    Worksheets("Sheet2").Range("Z" & J).Value = "" And _
                    (Worksheets("Sheet1").Range("c" & I).Value = Worksheets("Sheet2").Range("AF" & J).Value Or _
                    Worksheets("Sheet1").Range("K" & I).Value = Worksheets("Sheet2").Range("K" & J).Value Or _
                    Worksheets("Sheet1").Range("N" & I).Value = Worksheets("Sheet2").Range("L" & J).Value) Then

                    Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("match").Rows(lastRowN)
                    lastRowN = lastRowN + 1
                    Exit For


                    ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
                        Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
                        Worksheets("Sheet2").Range("Z" & J).Value = "" And _
                        Worksheets("Sheet1").Range("c" & I).Value <> Worksheets("Sheet2").Range("AF" & J).Value And _
                        Worksheets("Sheet1").Range("K" & I).Value <> Worksheets("Sheet2").Range("K" & J).Value And _
                        Worksheets("Sheet1").Range("N" & I).Value <> Worksheets("Sheet2").Range("L" & J).Value Then

                    ErrorMsg = "dates don't match"


                    ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
                        Worksheets("Sheet1").Range("B" & I).Value <> "Y" Then
                        ErrorMsg = "B column don't match"


                    ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
                        Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
                        Worksheets("Sheet2").Range("Z" & J).Value <> "" Then
                        ErrorMsg = "Z column don't match"


                    Else: ErrorMsg = "ISIN don't match"



                End If

     Next J

            Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("mismatch").Rows(lastRowM)
            Worksheets("mismatch").Range("S" & lastRowM).Value = ErrorMsg
            lastRowM = lastRowM + 1

Next I

            ' stop screen from updating to speed things up
            Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:0)

首先,我认为你应该为If..else方法中的每个子句添加“Exit For”。否则会导致你的“未命中匹配”结果几乎与“ISIN不匹配”这一事实。

其次,我认为您应该在ErrorMsg = ""之前设置For J = LastRowISINNR To 2 Step -1,并在输入表单未命中匹配时输入条件ErrorMsg <> ""

Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("mismatch").Rows(lastRowM)
    Worksheets("mismatch").Range("S" & lastRowM).Value = ErrorMsg
    lastRowM = lastRowM + 1

否则,您所有的行匹配或不匹配都会输入到未匹配的匹配表中。