请根据您的需求，运用您的VBA技能和自由裁量权来定制以下代码。
Public Sub Add_Msng_And_Check_Prev_EmpData()
'' Objective : Check missing employees from the incoming data placed in the Destination_Sheet sheet which is the client's format.
'' The _Source_Sheet sheet is our destination where processed data sits,
'' columns from Destination_Sheet are mapped to specific columns of the _Source_Sheet sheet.
'' Copy the missing emp codes to these mapped columns.
'' Support : [email protected]
'' Status : Production 14-Dec-2016 10.32 PM
'' Version : 1.0
'' To Do : 10 is the column number on Source_Sheet where the emp code resides
'' Convert this magic number to a generic solution
Dim Src_Sheet, Destination_Sheet As Worksheet
Dim Dest_Sheet_Column_Mapping, Src_Sheet_Column_Location As Range
Set Src_Sheet = Sheets("Source_Sheet")
Set Destination_Sheet = Sheets("Destination_Sheet")
Set Dest_Sheet_Column_Mapping = Sheets("ControlPanel").Range("A2:A60")
Set Src_Sheet_Column_Location = Sheets("ControlPanel").Range("D2:D60")
Dim myMap() As Integer
Dim myRow As Variant
ReDim myMap(Dest_Sheet_Column_Mapping.Count + 1)
'' Map the source_columns to the destination_columns
For Each myRow In Src_Sheet_Column_Location
'' Index corresponds to Source_Sheet column
'' Value at Index to Destination_Sheet
'' for eg: Destination_Sheet.column = myMap(Src_Sheet.column)
myMap(myRow) = Dest_Sheet_Column_Mapping.Cells(myRow, 1).Value
Next myRow
Dim Primary_Key_Not_Null As Collection
Set Primary_Key_Not_Null = New Collection
Dim Master, Src_Sheet_Range, Src_Range As Range
Dim MissingEmployeeCode, LookupValue, tempVar, LookupResult As Variant
Dim LastRow, i, Src_Range_Rows_Count, Src_Sheet_Range_Rows_Count As Integer
'' This is the source of all new entries we need to search for.
Set Src_Sheet_Range = Destination_Sheet.Range(Destination_Sheet.Cells(1, myMap(10)), Destination_Sheet.Cells(Destination_Sheet.Cells(1048576, myMap(10)).End(xlUp).Row, myMap(10)))
Src_Sheet_Range_Rows_Count = Src_Sheet_Range.Rows.Count
'' This is the database of all previous existing entries we need to search against.
Set Src_Range = Src_Sheet.Range(Src_Sheet.Cells(1, 10), Src_Sheet.Cells(Src_Sheet.Cells(1048576, 10).End(xlUp).Row, 10))
Src_Range_Rows_Count = Src_Range.Rows.Count
For i = 3 To Src_Sheet_Range_Rows_Count
'' Skip the blank rows and header at rows 0 to 2
On Error Resume Next
LookupValue = Destination_Sheet.Cells(i, myMap(10)).Value
LookupResult = Application.Match(LookupValue, Src_Range, 0)
If (IsError(LookupResult)) Then
'' To Do : Check for Duplicates within the previously added values
'' LookupValue becomes your missing empcode and i is the row number it's located at
'' The row number i becomes critical when you want to copy the same record that you have just found missing.
Primary_Key_Not_Null.Add i '' LookupValue
'' LookupValue is the actual missing empcode, however we need the row number for the copy operation later
End If
Next i
LastRow = Src_Sheet.Cells(1048576, 10).End(xlUp).Offset(1, 0).Row
Dim FirstRow, LastColumn, j, Src_Range_Columns_Count As Integer
FirstRow = LastRow
''--Phase 3--------------------------------------------------------------------------------------------------
'' Objective : Get and paste data for each missing empcode
With Src_Range
LastColumn = .Cells(1, 1).End(xlToRight).Column
LastRow = Primary_Key_Not_Null.Count + FirstRow
Set Src_Range = .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
Src_Range_Columns_Count = Src_Range.Columns.Count
For i = FirstRow To LastRow ''FirstRow + 3 '' Commented for Debugging
For j = 1 To Src_Range_Columns_Count '' 59
'' The simple logic is Row Numbers and Column numbers obtained from all the above operations
'' define the cells in the Src_Sheet sheet that we need this data pasted ito.
'' For details please see the code below.
Src_Sheet.Cells(i, j).Value = Destination_Sheet.Cells(Primary_Key_Not_Null(i - FirstRow + 1), myMap(j)).Value
Next j
Next i
End With
''--Phase 4--------------------------------------------------------------------------------------------------
'' Objective : For the previous range in Source_Sheet, check each cell in each column against the mapped columns in the Destination_Sheet.
'' When you find a discrepancy: style it Bad, for the matches: style it Good,
'' for the not found : Style it neutral.
LastRow = FirstRow
FirstRow = 2
Set Src_Range = Src_Sheet.Range(Src_Sheet.Cells(2, 1), Src_Sheet.Cells(LastRow, LastColumn))
Src_Range.Style = "Normal"
Dim FoundRow, FoundColumn As Integer
FoundRow = 0
FoundColumn = 10
Dim LookupRange, LookupDatabase As Range
Set LookupRange = Src_Sheet.Range(Src_Sheet.Cells(1, 10), Src_Sheet.Cells(LastRow, 10))
Set LookupDatabase = Destination_Sheet.Range(Destination_Sheet.Cells(1, myMap(10)), Destination_Sheet.Cells(Src_Sheet_Range_Rows_Count, myMap(10)))
Dim FoundRows As Collection
Set FoundRows = New Collection
'' Locate the row of each employee code on Emp Master, push it into a collection and let the emp code be it's key
Dim LookupRange_Row_Count As Integer
LookupRange_Row_Count = LookupRange.Rows.Count
For i = 2 To LookupRange_Row_Count
On Error Resume Next
FoundRow = Application.Match(LookupRange.Cells(i, 1).Value, LookupDatabase, 0)
If (Not IsError(FoundRow)) Then
'' myRow contains EmpCode which is the key, FoundRow = Where I Found it, becomes the value.
FoundRows.Add FoundRow, CStr(LookupRange.Cells(i, 1).Value)
End If
Next i
Dim Src_Sheet_Value, EmpMstrValue, myEmpCodeString As String
For i = FirstRow To LastRow '' 2 to 1029
For j = 1 To Src_Range_Columns_Count '' 59
'' Handle 4 cases.
'' 1. Src_Sheet Cell Value Found and matches = Good
'' 2. Src_Sheet Cell Value Found and does not match = Bad
'' 3. Src_Sheet Cell Value Not Found or not in Scope and hence does not match = Neutral
'' 4. Src_Sheet Cell Value is a duplicate of a value which is already checked earlier. = ??
Src_Sheet_Value = Src_Sheet.Cells(i, j).Value
myEmpCodeString = CStr(LookupRange.Cells(i, 1).Value)
myRow = CInt(FoundRows(myEmpCodeString))
EmpMstrValue = Destination_Sheet.Cells(myRow, myMap(j)).Value
'' Implements 1. Src_Sheet Cell Value Found and matches = Good
If Src_Sheet_Value = EmpMstrValue Then
Src_Sheet.Cells(i, j).Style = "Good"
Else
Src_Sheet.Cells(i, j).Style = "Bad"
End If
Next j
Next i
End Sub
