如何比較Excel 2010中兩個不同工作表之間的多行？

-2

工作表1（今年）：如何比較Excel 2010中兩個不同工作表之間的多行？

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

我需要檢查所有學生的標誌和生日，並比較這兩年的那些信息。（學生的生日不會改變，但我需要驗證生日記錄是否一致）

我希望我能得到如下的結果，我如何實現這一目標？

enter image description here

----------------------------------------- --------- 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

來源

2015-12-30 bh14029

試試下面的代碼。

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

來源

2015-12-30 10:23:48

謝謝你，代碼已經過測試和工作。 – bh14029

如果代碼爲你工作，然後進行投票 –

請嘗試以下代碼。

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

來源

2015-12-31 03:33:24

如何比較Excel 2010中兩個不同工作表之間的多行？

回答

相關問題