Dim fso,f,a

set oExcel = CreateObject( "Excel.Application" )

oExcel.Visible = false

'4) 打开已存在的工作簿：

oExcel.WorkBooks.Open( "F:\1.xlsx" )

On Error Resume Next

'判断是否存在Sheet2工作表,不存在新建

If oExcel.WorkSheets("Sheet2") Is Nothing Then

    MsgBox "不存在,开始执行"

    oExcel.Worksheets.Add

Else MsgBox "存在"

End If

'5) 设置第1个工作表为活动工作表：

oExcel.WorkSheets("Sheet1").Activate

'读取txt文档

Set fso = CreateObject("Scripting.FileSystemObject")

Set f=fso.OpenTextFile("D:\UnexistFile.txt",)

'逐行读取并赋值到变量a,Do...loop循环

DO While f.AtEndOfStream <> True

 i =

 a=f.ReadLine

 'msgbox a

 oExcel.WorkSheets("Sheet1").Activate

 Do while oExcel.Cells(i,).Value <> "" '查找A列中所有的单元格

    '设置某个单元格中的数据赋值到变量

    'b=oExcel.Cells(i,4).Value

    'c=oExcel.Cells(i,17).Value

    d=oExcel.Cells(i,).Value

    'e=oExcel.Cells(i,21).Value

    '判断单元格数据是否与txt数据相等

    if oExcel.Cells(i,).Value = a then 'i是行，4是列

        'oExcel.Cells(i,4).font.color = vbred '设置字体底色为红色

        'msgbox "行"&i &"列"

        oExcel.ActiveSheet.Range("A" & i & ":" & "X" & i).Cut

        oExcel.WorkSheets("Sheet2").Activate

        oExcel.ActiveSheet.Range("A1:X1").Insert

        oExcel.WorkSheets("Sheet1").Activate

        oExcel.ActiveSheet.Rows(i).Delete

    ElseIf Instr(b,a)> then  '判断txt的数据是否被包含在单元格中

        'msgbox "行"&i &"列"

        oExcel.ActiveSheet.Range("A" & i & ":" & "X" & i).Cut

        oExcel.WorkSheets("Sheet2").Activate

        oExcel.ActiveSheet.Range("A1:X1").Insert

        oExcel.WorkSheets("Sheet1").Activate

        oExcel.ActiveSheet.Rows(i).Delete

    Elseif oExcel.Cells(i,).Value = a then

        'msgbox "行"&i &"列"

        oExcel.ActiveSheet.Range("A" & i & ":" & "X" & i).Cut

        oExcel.WorkSheets("Sheet2").Activate

        oExcel.ActiveSheet.Range("A1:X1").Insert

        oExcel.WorkSheets("Sheet1").Activate

        oExcel.ActiveSheet.Rows(i).Delete

        'EXIT do

    end if

    i = i+

 loop

loop

oExcel.ActiveWorkBook.Save

oExcel.WorkBooks.Close

oExcel.Quit

set oExcel = nothing

msgbox "操作完成"