0

考虑下面的 Excel 表:

  Emp Id    Job Status
    741         P
    788         T
    111         T
    124         P
    136         P

我想要一个高级的 VBScript 代码,它可以一次完成这样的过滤,就像我们在 Excel 中手动完成的那样。过滤后,我希望第一列过滤值只放入一个数组中。

代码

Dim IntRow1,Arr,Index
Index=0

Do while objSheet1.Cells(IntRow1,1) <> ""
    If objSheet1.Cells(IntRow1,2) = "P" Then
        Arr(Index)=objSheet1.Cells(IntRow1,1)
        Index=Index+1
    End If
IntRow1=IntRow1=1
Loop

*更新

Option Explicit

Dim Dic, DicItems, Dickeys
Dim objExcel1
Dim strPathExcel1
Dim objSheet1, lastRow

Set objExcel1 = CreateObject("Excel.Application")

strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.Open strPathExcel1
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)

Set Dic = CreateObject("Scripting.Dictionary")

lastRow = 1
Do Until lastRow > objExcel1.Application.WorksheetFunction.CountA(objSheet1.Columns(1))
    Dic.Add objSheet1.Cells(lastRow, 1).Value, objSheet1.Cells(lastRow, 2).Value
    lastRow = lastRow + 1
Loop

DicItems = Dic.Items
Dickeys = Dic.Keys

For lastRow = 0 To Dic.Count - 1
    If DicItems(lastRow) = "P" Then
        Dic.Remove (Dickeys(lastRow))
    End If
Next

DicItems = Dic.Items
'=======================
objExcel1.ActiveWorkbook.SaveAs strPathExcel1
objExcel1.Workbooks.Close
objExcel1.Application.Quit
'======================
4

1 回答 1

-1

请看我的回答:

选项显式

 Dim Dic,DicItems,Dickeys
 Dim objExcel1
 Dim strPathExcel1
 Dim objSheet1,lastRow

 Set objExcel1 = CreateObject("Excel.Application")

 strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
 objExcel1.Workbooks.open strPathExcel1
 Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)

 Set Dic = CreateObject("Scripting.Dictionary")

 lastRow=1
  Do Untill lastRow >         objExcel1.Application.WorksheetFunction.CountA(objSheet1.Columns(1))

  Dic.Add objSheet1.Cells(lastRow,1).Value,objSheet1.Cells(lastRow,2).Value

 lastRow=lastRow+1
 Loop

DicItems=Dic.Items
Dickeys=Dic.Keys

 For lastRow=0 to Dic.Count -1

 If DicItems(lastRow)="P" Then

    Dic.Remove(Dickeys(lastRow))

 End If

  Next

 DicItems=Dic.Items

 '=======================
  objExcel1.ActiveWorkbook.SaveAs strPathExcel1
  objExcel1.Workbooks.close
  objExcel1.Application.Quit
 '======================
于 2012-12-18T15:20:03.337 回答