VBS读取txt文档数据查找Excel中单元格数据符合条件的剪切到工作表2中

时间:2021-02-04 16:01:28
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 "操作完成"