用vbscripting操控excel：比较两张excel表的不同并复制出来放到新建表中

用vbscripting操控excel：比较两张excel表的不同并复制出来放到新建表中 

''''''''''''''''''''''''''''''''''''''''''''''''''''''
'以电缆编号为索引，比较两张表的差异，并将两张表的差异
'罗列在一张新表中
'差异要求：1。A表有B表没有的元组，存放在ASheet中
'       2。B表有A表没有的元组，存放在BSheet中
'       3。当两张表的电缆编号相同时候，比较两个元组
'        并将不同的元组写到difbook中
'在表的V列标记：    
'       1.记录为独立存在，在A和B表中标记：missing(淡黄色)
'       2.当记录存在，但在两个记录并不完全相同的标记：difference(浅紫色)
'       3.当两条记录完全相同的标记；OK
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

const APathOfExcel =  "F: ew bookGWS348_主干电缆拉放册9-27导入用.xls"
const BPathOFExcel =  "F: ew book主干电缆拉放册10-9不能.xls" 

'ARows：A表表示需要搜索的地方是：B列的第三行开始到第14行结束
'BRows：同理
const BRows = "B1:B1000" 
const ARows = "B5:B1000"
'LengthOfA 是A表最后的行数
'LengthOfB 是B表最后的行数
const LengthOFA = 1000
const LengthOfB = 1000
const AStartRow = 5
const BStartRow = 1

'Length 表示两个excel表的列数（不包含备注）
const StartCol = 2
const Length = 19 

'注释在那一行
const N = 21


dim xcl 
'xBook为A表，yBook为B表
dim xBook,yBook

'xSheet1为xBook的第一张Excel表
'ySheet1为yBook的第一张Excel表
dim xSheet1,ySheet1

'addbook为用于存放差异的Excel表
dim addbook
dim DifSheet,ASheet,BSheet
'j,k为变量，具有指针作用
dim j,k,l

dim yEachC,xEachC


set xcl = CreateObject("Excel.application")
xcl.Visible = true
set xBook = xcl.Workbooks.Open( APathOfExcel ) 
set xSheet1 = xBook.WorkSheets(1)
set yBook = xcl.Workbooks.Open( BPathOFExcel ) 
set ySheet1 = yBook.WorkSheets(1)

set yEachC = ySheet1.cells
set xEachC = xSheet1.cells

set addBook = xcl.Workbooks.add
set difSheet = addBook.WorkSheets(1)
set ASheet = addBook.WorkSheets(2)
set BSheet = addBook.WorkSheets(3)

j = 1
k = 1
l = 1
'调用搜索函数
call SearchSub()
call BMissing()

difSheet.name = "difference"
ASheet.name = "ASheet"
BSheet.name = "BSheet"

call FreeSub()
msgbox "It's over!!!!!"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'SearchSub函数：这是一个搜索函数
'主要功能是： 搜索A表中 b表不存在的元素
'          当电缆编号相同时，比较元组中的相，
'            把有差异的元组列出来
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub SearchSub()
dim i
dim YN
'IRow用于存储ySheet1的行号码
dim IRow

for i = AStartRow to LengthOfA
'    for each yEachC in LengthOfB
    for each yEachC in ySheet1.Range(BRows)
        if xSheet1.cells(i,2).value <> " " then
            if yEachC.value = xSheet1.cells(i,2).value then
                YN = "Y"
                IRow = yEachC.Row
                Exit for
            else
                YN = "N"
            End if    
        End if
    Next
    if YN = "N" then
        xSheet1.rows(i).copy ASheet.rows(j)
        j=j+1
        '对不存在的row上色，并且标记
        xSheet1.rows(i).Interior.colorIndex = "36"
        xSheet1.cells(i,N).value = "missing"
    else
        Call Difference(i,IRow)
    End if
Next
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Difference函数：当查找到相同电缆时，就使用diffrence函数
'对比两个元组中的每一个cell是否相同
'i为xSheet的行指针，IRow为ysheet的行指针
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Difference(i,IRow)
dim j
dim IsCopy
IsCopy = "N"
dim f,g

'if xSheet1.cells(i,2).value <> " " then
    xSheet1.cells(i , N).value = "OK"
    ySheet1.cells(IRow , N).value = "OK"
'end if
for j = StartCol to Length
    if xSheet1.cells(i,j).value <> ySheet1.cells(Irow,j).value then
        if Iscopy = "N" then
            xSheet1.rows(i).copy difSheet.rows(k)
            xSheet1.rows(i).Interior.colorIndex = "39"
            difSheet.Cells(k,j).Interior.colorIndex = "37"
            f = k
            k = k + 1        
            ySheet1.rows(Irow).copy difSheet.rows(k)
            ySheet1.rows(Irow).Interior.colorIndex = "39"
            difSheet.Cells(k,j).Interior.colorIndex = "37"
            g = k
            k = k + 2
            xSheet1.cells(i,N).value = "difference"
            ySheet1.cells(IRow,N).value = "difference"
            IsCopy = "Y"
        else
            difSheet.Cells(f,j).Interior.colorIndex = "37"
            difSheet.Cells(g,j).Interior.colorIndex = "37"
        end if
    End if    
Next    
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'这是一个补充搜索：BMissing 表示 B存在而A没有的元组
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub BMissing()
dim i
dim YN
for i= BStartRow to LengthOfB
    for each xEachC in xSheet1.Range(ARows)
        if xEachC.value = ySHeet1.cells(i,2).value then
            YN = "Y"
            Exit for
        else
            YN = "N"
        End if
    Next
    if YN = "N" then
        ySheet1.rows(i).copy BSheet.rows(l)
        l = l + 1 
        ySheet1.rows(i).Interior.colorIndex = "36"
        ySheet1.cells(i,N).value = "missing"        
    End if
Next
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'释放全局变量
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FreeSub()
set xEachC = nothing
set yEachC = nothing
Set BSheet = nothing
Set ASheet = nothing
set DifSheet = nothing
set addBook = nothing
set ySheet1 = nothing
set xSheet1 = nothing
set xBook = nothing
set yBook = nothing
set xcl = nothing
End Sub