从ｅｘｃｅｌ中查找另一个ｅｘｃｅｌ中的号码是否存在

'******************************************
'*处理从既存数据中查找是否存在曾经用过的数据
'*既存数据ｅｘｃｅｌ要求：
'*   1.既存数据的列名为"MSN"
'*  2.列名所在行为sheet页中第2行
'*查询数据excel要求：
'*   1.查找的MSN的列名为"MSN"
'*　  2.列名所在行为sheet页中第１行
'*   3.记录文件名的列为ｍｓｎ列的下一列
'******************************************

 

Option Explicit

Const COL_NAME = "MSN"                  '既存数据的列名为"MSN";  查找的MSN的列名为"MSN"
Const ORIGINAL_TITLE_ROW_NUM = 2  '既存数据EXCEL列名所在行为sheet页中第2行
Const RESULT_TITLE_ROW_NUM = 1   '查询数据excel列名所在行为sheet页中第１行

Dim WshShell
set WshShell = CreateObject("wscript.Shell")

'打开既存数据的Excel文件=============
Call WshShell.Popup("准备选择既存数据的Excel", 2)
dim OriginalPath
OriginalPath = GetFilePath
'打开要查询的excel文档
Dim oOriginalExcel
Dim oOriginalBook
Call OpenExcel(oOriginalExcel, oOriginalBook, OriginalPath)
'=======================================

 

'打开需查询数据的Excel文件=============
Call WshShell.Popup("准备选择查询数据的Excel", 2)
dim ResultPath
ResultPath = GetFilePath
'打开要查询的excel文档
Dim oResultExcel
Dim oResultBook
Call OpenExcel(oResultExcel, oResultBook, ResultPath)
'=======================================

Dim oResultSheet
Set oResultSheet = oResultExcel.activesheet
Dim inResultMSNCol
inResultMSNCol = GetColNumByName(oResultSheet, RESULT_TITLE_ROW_NUM, COL_NAME)

dim i
For i = 2 To oResultSheet.UsedRange.rows.Count
 Dim strFind
 strFind = CStr(oResultSheet.cells(i, inResultMSNCol))
 If (strFind = "") Then
  
 ElseIf FindStrFromExcel(oOriginalBook, strFind) Then
  oResultSheet.cells(i, inResultMSNCol + 1).value = oResultSheet.cells(i, inResultMSNCol + 1).value & vbCrLf & OriginalPath
 End if
Next

 

oResultExcel.save
Call WshShell.Popup("数据查询已结束！数据已保存！", 2)

 

oResultExcel.quit
oOriginalExcel.quit
Set oResultExcel = nothing
Set oOriginalExcel = Nothing
Set WshShell = nothing
WScript.Quit

 

 

 

'==================sub & function==================

sub OpenExcel(ByRef obj, ByRef workbook, path)
 On Error Resume Next
 '打开excel文档
 Set obj = CreateObject("excel.application")
 obj.Visible = false
 Set workbook = obj.Workbooks.Open(path)
 If Err.Number <> 0 Then
  obj.Quit
  WScript.Quit
 End If

End sub

 

Function GetFilePath
 Dim objDialog
 Set objDialog = CreateObject("UserAccounts.CommonDialog")
 objDialog.Filter = "Excel97-2003|*.xls|Excel2007|*.xlsx"
 objDialog.InitialDir = "c:/"
 Dim tfile
 tfile=objDialog.ShowOpen
 if tfile then
  GetFilePath = objDialog.FileName
 else
  WScript.Quit
 end if
End Function

 

'获得处理字段所在列
Function GetColNumByName(ByRef sheet, byval inTitleRow, ByVal strColName)

 GetColNumByName = 0
 Dim index
 For index = 1 To sheet.UsedRange.columns.Count
  If sheet.cells(inTitleRow, index) = strColName Then
   GetColNumByName = index
   Exit Function
  End if
 Next
End Function

 

'查看此sheet中是否存在MSN
Function StrExistsInSheet(ByRef sheet, byval inCol, ByVal strMSN)
 StrExistsInSheet = False
 Dim index
 For index = 2 To sheet.UsedRange.rows.Count
  If CStr(sheet.cells(index, inCol)) = strMSN Then
   StrExistsInSheet = true
   Exit Function
  End if
 Next
End Function

 

'查看此book中是否存在MSN
Function FindStrFromExcel(byref book, byval str)

 FindStrFromExcel = false

 Dim sheet
 For Each sheet In book.sheets
  Dim inMSNCol
  inMSNCol = GetColNumByName(sheet, ORIGINAL_TITLE_ROW_NUM, COL_NAME)
  If inMSNCol <> 0 Then
   If (StrExistsInSheet(sheet, inMSNCol, str)) Then
    FindStrFromExcel = True
    Exit function
   End if
  End If
 Next
 
End function