我们可以使用VBScript过滤值并将它们放入数组中吗?

时间:2012-12-18 12:09:42

标签: excel-vba vbscript vba excel

考虑以下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
'======================

1 个答案:

答案 0 :(得分:-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
 '======================