如何比较excel 2010中两个不同工作表之间的多行？答案

【问题标题】：How to compare multiple rows between two different worksheets in excel 2010?如何比较excel 2010中两个不同工作表之间的多行？
【发布时间】：2015-12-30 07:55:50
【问题描述】：

工作表 1（今年）：

Name       Birthday     Grade 1 Grade 2 Grade 3  

AAA        dd/mm/yyyy      B       A      B
BBB        dd1/mm/yyyy     A       B      C
CCC        dd/mm/yyyy      B       C      D
DDD        dd/mm/yyyy      C       D      C

工作表 2（去年）：

Name       Birthday     Grade 1 Grade 2 Grade 3   

BBB        dd/mm/yyyy      B       B      B
AAA        dd/mm/yyyy      A       A      A
DDD        dd/mm/yyyy      D       D      D
CCC        dd/mm/yyyy      C       C      C

我需要检查所有学生的分数和生日，并比较这两年的这些信息。（学生的生日不会更改，但我需要验证生日记录是否一致）

我希望我能得到如下结果，我该如何实现？

----------------------------------------------- --- 12 月 31 日更新 ------------------------------- ------------

感谢“RAJA THEVAR”提供的代码，这两个工作表可以进行比较。

实际上将比较三 (3) 个日期条目和十二 (12) 个年级条目。

我修改了代码，发现它变得有点冗长。我希望可以通过使用一些循环、数组等来简化它。

有没有办法做到这一点？

选项显式

Sub Test()

Dim thisyearlstr As Integer

Dim Lastyearlstr As Integer

Dim Resultlstr As Integer


Dim thisyearbday As String

Dim Lastyearbday As String

Dim thisyrAday As String

Dim lastyrAday As String

Dim thisyrRday As String

Dim lastyrRday As String


Dim thisyearg1 As String

Dim thisyearg2 As String

Dim thisyearg3 As String

Dim thisyearg4 As String

Dim thisyearg5 As String

Dim thisyearg6 As String

Dim thisyearg7 As String

Dim thisyearg8 As String

Dim thisyearg9 As String

Dim thisyearg10 As String

Dim thisyearg11 As String

Dim thisyearg12 As String


Dim lastyearg1 As String

Dim lastyearg2 As String

Dim lastyearg3 As String

Dim lastyearg4 As String

Dim lastyearg5 As String

Dim lastyearg6 As String

Dim lastyearg7 As String

Dim lastyearg8 As String

Dim lastyearg9 As String

Dim lastyearg10 As String

Dim lastyearg11 As String

Dim lastyearg12 As String

Dim i As Integer

Dim lookup As String ' name under check

Dim grade1 As Integer

Dim grade2 As Integer

Dim grade3 As Integer

Dim grade4 As Integer

Dim grade5 As Integer

Dim grade6 As Integer

Dim grade7 As Integer

Dim grade8 As Integer

Dim grade9 As Integer

Dim grade10 As Integer

Dim grade11 As Integer

Dim grade12 As Integer

ThisWorkbook.Sheets("Result").Activate
Cells.Select

Selection.Delete Shift:=xlUp

' Writing labels to first row
ThisWorkbook.Sheets("Result").Range("A1").Value = "Name"

ThisWorkbook.Sheets("Result").Range("B1").Value = "Birthday"

ThisWorkbook.Sheets("Result").Range("C1").Value = "AppDay"

ThisWorkbook.Sheets("Result").Range("D1").Value = "RankDay"

ThisWorkbook.Sheets("Result").Range("E1").Value = "Grade 1"

ThisWorkbook.Sheets("Result").Range("F1").Value = "Grade 2"

ThisWorkbook.Sheets("Result").Range("G1").Value = "Grade 3"

ThisWorkbook.Sheets("Result").Range("H1").Value = "Grade 4"

ThisWorkbook.Sheets("Result").Range("I1").Value = "Grade 5"

ThisWorkbook.Sheets("Result").Range("J1").Value = "Grade 6"

ThisWorkbook.Sheets("Result").Range("K1").Value = "Grade 7"

ThisWorkbook.Sheets("Result").Range("L1").Value = "Grade 8"

ThisWorkbook.Sheets("Result").Range("M1").Value = "Grade 9"

ThisWorkbook.Sheets("Result").Range("N1").Value = "Grade 10"

ThisWorkbook.Sheets("Result").Range("O1").Value = "Grade 11"

ThisWorkbook.Sheets("Result").Range("P1").Value = "Grade 12"

Resultlstr = ThisWorkbook.Sheets("Result").Range("A60000").End(xlUp).Row + 1

thisyearlstr = ThisWorkbook.Sheets("This year").Range("A60000").End(xlUp).Row

Lastyearlstr = ThisWorkbook.Sheets("Last year").Range("A60000").End(xlUp).Row

' Copy all names in "This year" to "Result" Worksheet
ThisWorkbook.Sheets("This year").Range("A2:A" & thisyearlstr).Copy

ThisWorkbook.Sheets("Result").Range("A" & Resultlstr).PasteSpecial

Resultlstr = ThisWorkbook.Sheets("Result").Range("A60000").End(xlUp).Row

For i = 2 To Resultlstr

lookup = ThisWorkbook.Sheets("Result").Range("A" & i).Value ' lookup = name under check

thisyearbday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:B"), 2, 0) ' store B-day of the name under check

thisyrAday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:C"), 3, 0)

thisyrRday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:D"), 4, 0)

Lastyearbday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:B"), 2, 0)

lastyrAday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:C"), 3, 0)

lastyrRday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:D"), 4, 0)


thisyearg1 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:E"), 5, 0)

thisyearg2 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:F"), 6, 0)

thisyearg3 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:G"), 7, 0)

thisyearg4 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:H"), 8, 0)

thisyearg5 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:I"), 9, 0)

thisyearg6 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:J"), 10, 0)

thisyearg7 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:K"), 11, 0)

thisyearg8 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:L"), 12, 0)

thisyearg9 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:M"), 13, 0)

thisyearg10 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:N"), 14, 0)

thisyearg11 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:O"), 15, 0)

thisyearg12 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:P"), 16, 0)


lastyearg1 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:E"), 5, 0)

lastyearg2 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:F"), 6, 0)

lastyearg3 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:G"), 7, 0)

lastyearg4 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:H"), 8, 0)

lastyearg5 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:I"), 9, 0)

lastyearg6 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:J"), 10, 0)

lastyearg7 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:K"), 11, 0)

lastyearg8 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:L"), 12, 0)

lastyearg9 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:M"), 13, 0)

lastyearg10 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:N"), 14, 0)

lastyearg11 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:O"), 15, 0)

lastyearg12 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:P"), 16, 0)


ThisWorkbook.Sheets("Result").Range("B" & i).Value = thisyearbday ' writing stored data to "Result" worksheet
ThisWorkbook.Sheets("Result").Range("C" & i).Value = thisyrAday
ThisWorkbook.Sheets("Result").Range("D" & i).Value = thisyrRday
ThisWorkbook.Sheets("Result").Range("E" & i).Value = thisyearg1
ThisWorkbook.Sheets("Result").Range("F" & i).Value = thisyearg2
ThisWorkbook.Sheets("Result").Range("G" & i).Value = thisyearg3
ThisWorkbook.Sheets("Result").Range("H" & i).Value = thisyearg4
ThisWorkbook.Sheets("Result").Range("I" & i).Value = thisyearg5
ThisWorkbook.Sheets("Result").Range("J" & i).Value = thisyearg6
ThisWorkbook.Sheets("Result").Range("K" & i).Value = thisyearg7
ThisWorkbook.Sheets("Result").Range("L" & i).Value = thisyearg8
ThisWorkbook.Sheets("Result").Range("M" & i).Value = thisyearg9
ThisWorkbook.Sheets("Result").Range("N" & i).Value = thisyearg10
ThisWorkbook.Sheets("Result").Range("O" & i).Value = thisyearg11
ThisWorkbook.Sheets("Result").Range("P" & i).Value = thisyearg12

' Determine if b-day entries in two worksheets are the same
   If thisyearbday = Lastyearbday Then
   ThisWorkbook.Sheets("Result").Range("B" & i).Interior.Color = RGB(217, 217, 217)
   Else
   ThisWorkbook.Sheets("Result").Range("B" & i).Interior.Color = RGB(204, 192, 218)
   End If

   If thisyrAday = lastyrAday Then
   ThisWorkbook.Sheets("Result").Range("C" & i).Interior.Color = RGB(217, 217, 217)
   Else
   ThisWorkbook.Sheets("Result").Range("C" & i).Interior.Color = RGB(204, 192, 218)
   End If

   If thisyrRday = lastyrRday Then
   ThisWorkbook.Sheets("Result").Range("D" & i).Interior.Color = RGB(217, 217, 217)
   Else
   ThisWorkbook.Sheets("Result").Range("D" & i).Interior.Color = RGB(204, 192, 218)
   End If

   grade1 = Comparegrade(thisyearg1, lastyearg1)
   If grade1 = 0 Then
   ThisWorkbook.Sheets("Result").Range("E" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade1 < 0 Then
   ThisWorkbook.Sheets("Result").Range("E" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade1 > 0 Then
   ThisWorkbook.Sheets("Result").Range("E" & i).Interior.Color = RGB(216, 228, 188)
   End If


   grade2 = Comparegrade(thisyearg2, lastyearg2)
   If grade2 = 0 Then
   ThisWorkbook.Sheets("Result").Range("F" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade2 < 0 Then
   ThisWorkbook.Sheets("Result").Range("F" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade2 > 0 Then
   ThisWorkbook.Sheets("Result").Range("F" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade3 = Comparegrade(thisyearg3, lastyearg3)
   If grade3 = 0 Then
   ThisWorkbook.Sheets("Result").Range("G" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade3 < 0 Then
   ThisWorkbook.Sheets("Result").Range("G" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade3 > 0 Then
   ThisWorkbook.Sheets("Result").Range("G" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade4 = Comparegrade(thisyearg4, lastyearg4)
   If grade4 = 0 Then
   ThisWorkbook.Sheets("Result").Range("H" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade4 < 0 Then
   ThisWorkbook.Sheets("Result").Range("H" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade4 > 0 Then
   ThisWorkbook.Sheets("Result").Range("H" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade5 = Comparegrade(thisyearg5, lastyearg5)
   If grade5 = 0 Then
   ThisWorkbook.Sheets("Result").Range("I" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade5 < 0 Then
   ThisWorkbook.Sheets("Result").Range("I" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade5 > 0 Then
   ThisWorkbook.Sheets("Result").Range("I" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade6 = Comparegrade(thisyearg6, lastyearg6)
   If grade6 = 0 Then
   ThisWorkbook.Sheets("Result").Range("J" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade6 < 0 Then
   ThisWorkbook.Sheets("Result").Range("J" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade6 > 0 Then
   ThisWorkbook.Sheets("Result").Range("J" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade7 = Comparegrade(thisyearg7, lastyearg7)
   If grade7 = 0 Then
   ThisWorkbook.Sheets("Result").Range("K" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade7 < 0 Then
   ThisWorkbook.Sheets("Result").Range("K" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade7 > 0 Then
   ThisWorkbook.Sheets("Result").Range("K" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade8 = Comparegrade(thisyearg8, lastyearg8)
   If grade8 = 0 Then
   ThisWorkbook.Sheets("Result").Range("L" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade8 < 0 Then
   ThisWorkbook.Sheets("Result").Range("L" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade8 > 0 Then
   ThisWorkbook.Sheets("Result").Range("L" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade9 = Comparegrade(thisyearg9, lastyearg9)
   If grade9 = 0 Then
   ThisWorkbook.Sheets("Result").Range("M" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade9 < 0 Then
   ThisWorkbook.Sheets("Result").Range("M" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade9 > 0 Then
   ThisWorkbook.Sheets("Result").Range("M" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade10 = Comparegrade(thisyearg10, lastyearg10)
   If grade10 = 0 Then
   ThisWorkbook.Sheets("Result").Range("N" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade10 < 0 Then
   ThisWorkbook.Sheets("Result").Range("N" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade10 > 0 Then
   ThisWorkbook.Sheets("Result").Range("N" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade11 = Comparegrade(thisyearg11, lastyearg11)
   If grade11 = 0 Then
   ThisWorkbook.Sheets("Result").Range("O" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade11 < 0 Then
   ThisWorkbook.Sheets("Result").Range("O" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade11 > 0 Then
   ThisWorkbook.Sheets("Result").Range("O" & i).Interior.Color = RGB(216, 228, 188)
   End If

   grade12 = Comparegrade(thisyearg12, lastyearg12)
   If grade12 = 0 Then
   ThisWorkbook.Sheets("Result").Range("P" & i).Interior.Color = RGB(217, 217, 217)
   ElseIf grade12 < 0 Then
   ThisWorkbook.Sheets("Result").Range("P" & i).Interior.Color = RGB(230, 184, 183)
   ElseIf grade12 > 0 Then
   ThisWorkbook.Sheets("Result").Range("P" & i).Interior.Color = RGB(216, 228, 188)
   End If

Next


End Sub

Function Comparegrade(grade1, grade2)

If UCase(grade1) = "A" Then
grade1 = 4
ElseIf UCase(grade1) = "B" Then
grade1 = 3
ElseIf UCase(grade1) = "C" Then
grade1 = 2
ElseIf UCase(grade1) = "D" Then
grade1 = 1
End If

If UCase(grade2) = "A" Then
grade2 = 4
ElseIf UCase(grade2) = "B" Then
grade2 = 3
ElseIf UCase(grade2) = "C" Then
grade2 = 2
ElseIf UCase(grade2) = "D" Then
grade2 = 1
End If

Comparegrade = grade1 - grade2
End Function

【问题讨论】：

标签： arrays vba loops compare range

【解决方案1】：

试试下面的代码。

Option Explicit

    Sub Test()

    Dim thisyearlstr As Integer

    Dim Lastyearlstr As Integer

    Dim Resultlstr As Integer

    Dim thisyearbday As String

    Dim Lastyearbday As String

    Dim thisyearg1 As String

    Dim thisyearg2 As String

    Dim thisyearg3 As String

    Dim lastyearg1 As String

    Dim lastyearg2 As String

    Dim lastyearg3 As String

    Dim i As Integer

    Dim lookup As String

    Dim grade1 As Integer

    Dim grade2 As Integer

    Dim grade3 As Integer

    ThisWorkbook.Sheets("Result").Activate
    Cells.Select

    Selection.Delete Shift:=xlUp

    ThisWorkbook.Sheets("Result").Range("A1").Value = "Name"

    ThisWorkbook.Sheets("Result").Range("B1").Value = "Birthday"

    ThisWorkbook.Sheets("Result").Range("C1").Value = "Grade 1"

    ThisWorkbook.Sheets("Result").Range("D1").Value = "Grade 2"

    ThisWorkbook.Sheets("Result").Range("E1").Value = "Grade 3"

    Resultlstr = ThisWorkbook.Sheets("Result").Range("A60000").End(xlUp).Row + 1

    thisyearlstr = ThisWorkbook.Sheets("This year").Range("A60000").End(xlUp).Row

    Lastyearlstr = ThisWorkbook.Sheets("Last year").Range("A60000").End(xlUp).Row

    ThisWorkbook.Sheets("This year").Range("A2:A" & thisyearlstr).Copy

    ThisWorkbook.Sheets("Result").Range("A" & Resultlstr).PasteSpecial

    Resultlstr = ThisWorkbook.Sheets("Result").Range("A60000").End(xlUp).Row

    For i = 2 To Resultlstr

    lookup = ThisWorkbook.Sheets("Result").Range("A" & i).Value

     thisyearbday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:B"), 2, 0)

    Lastyearbday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:B"), 2, 0)


    thisyearg1 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:C"), 3, 0)


     thisyearg2 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:D"), 4, 0)

     thisyearg3 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:E"), 5, 0)

    lastyearg1 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:C"), 3, 0)


     lastyearg2 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:D"), 4, 0)

     lastyearg3 = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:E"), 5, 0)

         ThisWorkbook.Sheets("Result").Range("B" & i).Value = thisyearbday
        ThisWorkbook.Sheets("Result").Range("C" & i).Value = thisyearg1
       ThisWorkbook.Sheets("Result").Range("D" & i).Value = thisyearg2
       ThisWorkbook.Sheets("Result").Range("E" & i).Value = thisyearg3

       If thisyearbday = Lastyearbday Then
       ThisWorkbook.Sheets("Result").Range("B" & i).Interior.Color = RGB(217, 217, 217)
       Else
       ThisWorkbook.Sheets("Result").Range("B" & i).Interior.Color = RGB(204, 192, 218)
       End If
       grade1 = Comparegrade(thisyearg1, lastyearg1)
       If grade1 = 0 Then
       ThisWorkbook.Sheets("Result").Range("C" & i).Interior.Color = RGB(217, 217, 217)
       ElseIf grade1 < 0 Then
       ThisWorkbook.Sheets("Result").Range("C" & i).Interior.Color = RGB(230, 184, 183)
       ElseIf grade1 > 0 Then
       ThisWorkbook.Sheets("Result").Range("C" & i).Interior.Color = RGB(216, 228, 188)
       End If


      grade2 = Comparegrade(thisyearg2, lastyearg2)
       If grade2 = 0 Then
       ThisWorkbook.Sheets("Result").Range("D" & i).Interior.Color = RGB(217, 217, 217)
       ElseIf grade2 < 0 Then
       ThisWorkbook.Sheets("Result").Range("D" & i).Interior.Color = RGB(230, 184, 183)
       ElseIf grade2 > 0 Then
       ThisWorkbook.Sheets("Result").Range("D" & i).Interior.Color = RGB(216, 228, 188)
       End If
       grade3 = Comparegrade(thisyearg3, lastyearg3)
       If grade3 = 0 Then
       ThisWorkbook.Sheets("Result").Range("E" & i).Interior.Color = RGB(217, 217, 217)
       ElseIf grade3 < 0 Then
       ThisWorkbook.Sheets("Result").Range("E" & i).Interior.Color = RGB(230, 184, 183)
       ElseIf grade3 > 0 Then
       ThisWorkbook.Sheets("Result").Range("E" & i).Interior.Color = RGB(216, 228, 188)
       End If

    Next


    End Sub

    Function Comparegrade(grade1, grade2)

    If UCase(grade1) = "A" Then
    grade1 = 4


    ElseIf UCase(grade1) = "B" Then
    grade1 = 3


    ElseIf UCase(grade1) = "C" Then
    grade1 = 2



    ElseIf UCase(grade1) = "D" Then
    grade1 = 1

    End If

    If UCase(grade2) = "A" Then
    grade2 = 4


    ElseIf UCase(grade2) = "B" Then
    grade2 = 3


    ElseIf UCase(grade2) = "C" Then
    grade2 = 2

    ElseIf UCase(grade2) = "D" Then
    grade2 = 1

    End If

    Comparegrade = grade1 - grade2
    End Function

【讨论】：

【解决方案2】：

试试下面的代码。

Option Explicit

Sub Test()

Dim thisyearlstr As Integer

Dim Lastyearlstr As Integer

Dim Resultlstr As Integer


Dim thisyearbday As String

Dim Lastyearbday As String

Dim thisyrAday As String

Dim lastyrAday As String

Dim thisyrRday As String

Dim lastyrRday As String


Dim thisyearg As String

Dim lastyearg As String


Dim i As Integer

Dim lookup As String ' name under check

Dim grade1 As Integer

Dim grade2 As Integer


ThisWorkbook.Sheets("Result").Activate
Cells.Select

Selection.Delete Shift:=xlUp

' Writing labels to first row
ThisWorkbook.Sheets("Result").Range("A1").Value = "Name"

ThisWorkbook.Sheets("Result").Range("B1").Value = "Birthday"

ThisWorkbook.Sheets("Result").Range("C1").Value = "AppDay"

ThisWorkbook.Sheets("Result").Range("D1").Value = "RankDay"

ThisWorkbook.Sheets("Result").Range("E1").Value = "Grade 1"

ThisWorkbook.Sheets("Result").Range("F1").Value = "Grade 2"

ThisWorkbook.Sheets("Result").Range("G1").Value = "Grade 3"

ThisWorkbook.Sheets("Result").Range("H1").Value = "Grade 4"

ThisWorkbook.Sheets("Result").Range("I1").Value = "Grade 5"

ThisWorkbook.Sheets("Result").Range("J1").Value = "Grade 6"

ThisWorkbook.Sheets("Result").Range("K1").Value = "Grade 7"

ThisWorkbook.Sheets("Result").Range("L1").Value = "Grade 8"

ThisWorkbook.Sheets("Result").Range("M1").Value = "Grade 9"

ThisWorkbook.Sheets("Result").Range("N1").Value = "Grade 10"

ThisWorkbook.Sheets("Result").Range("O1").Value = "Grade 11"

ThisWorkbook.Sheets("Result").Range("P1").Value = "Grade 12"

Resultlstr = ThisWorkbook.Sheets("Result").Range("A60000").End(xlUp).Row + 1

thisyearlstr = ThisWorkbook.Sheets("This year").Range("A60000").End(xlUp).Row

Lastyearlstr = ThisWorkbook.Sheets("Last year").Range("A60000").End(xlUp).Row

' Copy all names in "This year" to "Result" Worksheet
ThisWorkbook.Sheets("This year").Range("A2:A" & thisyearlstr).Copy

ThisWorkbook.Sheets("Result").Range("A" & Resultlstr).PasteSpecial

Resultlstr = ThisWorkbook.Sheets("Result").Range("A60000").End(xlUp).Row

For i = 2 To Resultlstr

lookup = ThisWorkbook.Sheets("Result").Range("A" & i).Value ' lookup = name under check

thisyearbday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:B"), 2, 0) ' store B-day of the name under check

thisyrAday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:C"), 3, 0)

thisyrRday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:D"), 4, 0)

Lastyearbday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:B"), 2, 0)

lastyrAday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:C"), 3, 0)

lastyrRday = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("last year").Range("A:D"), 4, 0)

ThisWorkbook.Sheets("Result").Range("B" & i).Value = thisyearbday ' writing stored data to "Result" worksheet
ThisWorkbook.Sheets("Result").Range("C" & i).Value = thisyrAday
ThisWorkbook.Sheets("Result").Range("D" & i).Value = thisyrRday




' Determine if b-day entries in two worksheets are the same
   If thisyearbday = Lastyearbday Then
   ThisWorkbook.Sheets("Result").Range("B" & i).Interior.Color = RGB(217, 217, 217)
   Else
   ThisWorkbook.Sheets("Result").Range("B" & i).Interior.Color = RGB(204, 192, 218)
   End If

   If thisyrAday = lastyrAday Then
   ThisWorkbook.Sheets("Result").Range("C" & i).Interior.Color = RGB(217, 217, 217)
   Else
   ThisWorkbook.Sheets("Result").Range("C" & i).Interior.Color = RGB(204, 192, 218)
   End If

   If thisyrRday = lastyrRday Then
   ThisWorkbook.Sheets("Result").Range("D" & i).Interior.Color = RGB(217, 217, 217)
   Else
   ThisWorkbook.Sheets("Result").Range("D" & i).Interior.Color = RGB(204, 192, 218)
   End If


    For j = 5 To 16
    grade = ""
thisyearg = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("This year").Range("A:P"), j, 0)

lastyearg = WorksheetFunction.VLookup(lookup, ThisWorkbook.Sheets("Last year").Range("A:P"), j, 0)
ThisWorkbook.Sheets("Result").Cells(i, j).Value = thisyearg

grade = Comparegrade(thisyearg, lastyearg)

  If grade = 0 Then
   ThisWorkbook.Sheets("Result").Cells(i, j).Interior.Color = RGB(217, 217, 217)
   ElseIf grade1 < 0 Then
   ThisWorkbook.Sheets("Result").Cells(i, j).Interior.Color = RGB(230, 184, 183)
   ElseIf grade1 > 0 Then
   ThisWorkbook.Sheets("Result").Cells(i, j).Interior.Color = RGB(216, 228, 188)
End If

Next      

Next


End Sub

Function Comparegrade(grade1, grade2)

If UCase(grade1) = "A" Then
grade1 = 4
ElseIf UCase(grade1) = "B" Then
grade1 = 3
ElseIf UCase(grade1) = "C" Then
grade1 = 2
ElseIf UCase(grade1) = "D" Then
grade1 = 1
End If

If UCase(grade2) = "A" Then
grade2 = 4
ElseIf UCase(grade2) = "B" Then
grade2 = 3
ElseIf UCase(grade2) = "C" Then
grade2 = 2
ElseIf UCase(grade2) = "D" Then
grade2 = 1
End If

Comparegrade = grade1 - grade2
End Function

【讨论】：