如何将两个脚本合二为一?

时间:2012-12-14 19:10:53

标签: excel-vba vbscript vba excel

请阅读以下模板:

PID     Status      LPID

10       Closed      25
11       Open        25
31       Open        31
25       Closed      25
54       Open        31
17       Open        17
20       Closed      31
88       closed      77
77       closed      77
201      open       202
205      open        500

现在当PID!= LPID时,该PID被定义为CPID(子进程ID),否则它是PPID(父进程ID)

现在我正在寻找一个代码,它将告诉哪个是父级,哪个是子级 - 意味着在另一个工作表中标记它们。同时我想列出所有CPID,PPID在同一行,如果有任何PPID让孩子自己处理。输出将如下所示

PID   Type Of Process?    Child List
10       Child
11       Child
31       Parent              54 20
25       Parent              10 11
54       Child
17       Parent
20       Child
88       Child
77       Parent              88

我已经使用VBScript编写了一个代码,但实际的工作表太慢了。对于2500个数据,它需要接近1小时。所以我想要比我的更快的过程。

你能帮忙使用VBscript吗?

代码1:

  Set objExcel1 = CreateObject("Excel.Application")'Object for W2W Report Dump


  strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
  objExcel1.Workbooks.open strPathExcel1

  Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(2)
  Set objSheet2 = objExcel1.ActiveWorkbook.Worksheets(1)

    IntRow1=1
 Do While objSheet1.Cells(IntRow1, 1).Value <> ""

    IntRow2=4
    IntChildListColumn=3

    If objSheet1.Cells(IntRow1,2).Value="Parent" Then

        Do While objSheet2.Cells(IntRow2, 1).Value <> ""

             If objSheet2.Cells(IntRow2,11).Value=objSheet1.Cells(IntRow1,1).Value And objSheet2.Cells(IntRow2,11).Value <> objSheet2.Cells(IntRow2,1).Value Then

                 objSheet1.Cells(IntRow1,IntChildListColumn).Value=objSheet2.Cells(IntRow2,1).Value
                 IntChildListColumn=IntChildListColumn+1

             End If

      IntRow2=IntRow2+1

      Loop

   End If

 IntRow1=IntRow1+1

Loop

代码2:

 Flag=0
 IntColTemp=1
 IntRowTemp=3

 Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump


 strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
 objExcel1.Workbooks.open strPathExcel1

 Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
 Set objSheet2 = objExcel1.ActiveWorkbook.Worksheets(2)

 IntRow1=4
 IntRow2=1

Do While objSheet1.Cells(IntRow1, 1).Value <> ""

  objSheet2.Cells(IntRow2, 1).Value = objSheet1.Cells(IntRow1, 1).Value


   IntColTemp=1
   Flag=0
  'This will travarse to the Parent Business Process ID column horizantally in the excel.
  Do While Flag=0

  If objSheet1.Cells(IntRowTemp,IntColTemp).Value="Parent Business Process ID" Then

      Flag=1       

  End If

      IntColTemp=IntColTemp+1


Loop
      IntColTemp=IntColTemp-1
      'MsgBox(IntColTemp)

  Strcmp1=trim(objSheet1.Cells(IntRow1, 1).Value)
  Strcmp2=trim(objSheet1.Cells(IntRow1,IntColTemp).Value)

  If Strcmp1=Strcmp2 Then

      objSheet2.Cells(IntRow2, 2).Value="Parent" 

  Else

      objSheet2.Cells(IntRow2, 2).Value="child"

  End If


   IntRow1=IntRow1+1
   IntRow2=IntRow2+1

  Loop

编辑 看到两个ID 201和205具有子父关系。但是,子ID将需要出现在输出列中,但是父202和500不应该进入输出列表,因为主表202 close/open 202500 open/close 500

中没有任何内容

1 个答案:

答案 0 :(得分:1)

两个想法/策略:

  1. 将范围加载到数组中而不是访问单元格((c)@DanielCook)
  2. 如果必须处理有关(一组)元素的数据,请使用字典。
  3. 在代码中:

    Option Explicit
    
    Class cP
      Public m_sRel
      Public m_dicC
      Private Sub Class_Initialize()
        m_sRel     = "Child"
        Set m_dicC = CreateObject("Scripting.Dictionary")
      End Sub
      Public Function show()
        show = m_sRel & " " & Join(m_dicC.Keys)
      End Function
    End Class
    
    Dim oFS   : Set oFS  = CreateObject("Scripting.FileSystemObject")
    Dim oXls  : Set oXls = CreateObject("Excel.Application")
    Dim oWb   : Set oWb  = oXls.Workbooks.Open(oFs.GetAbsolutePathName(".\00.xlsx"))
    Dim aData : aData    = oWb.Worksheets(1).Range("$A2:$C10")
    Dim dicP  : Set dicP = CreateObject("Scripting.Dictionary")
    
    Dim nRow
    For nRow = LBound(aData, 1) To UBound(aData, 1)
        Set dicP(aData(nRow, 1)) = New cP
    Next
    
    For nRow = LBound(aData, 1) To UBound(aData, 1)
        If aData(nRow, 1) = aData(nRow, 3) Then
           dicP(aData(nRow, 1)).m_sRel = "Parent"
        Else
           dicP(aData(nRow, 3)).m_dicC(aData(nRow, 1)) = 0
        End If
    Next
    
    Dim nP
    For Each nP In dicP.Keys()
        WScript.Echo nP, dicP(nP).show()
    Next
    
    oWb.Close
    oXls.Quit
    

    输出:

    10 Child
    11 Child
    31 Parent 54 20
    25 Parent 10 11
    54 Child
    17 Parent
    20 Child
    88 Child
    77 Parent 88