用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