0

我有两个 .vbs 文件，比如 a.vbs 和 b.vbs。现在两者都是为同一个 Excel 编写的，但可以在 2 个不同的工作表上工作。那么我们可以并行运行它们吗？

编辑

a.vbs 将更新 sheet2，b.vbs 将更新 sheet3。但对于两个源表都是 sheet1。

请建议如何设置这样的环境

代码 A

Option Explicit

Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objSheet2
Dim IntRow1,IntRow2
Dim ColStart

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

 strPathExcel1 = "D:\AravoVB\Copy of Original     Scripts\CopyofGEWingtoWing_latest_dump_21112012.xls"
 objExcel1.Workbooks.open strPathExcel1
 Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
 Set objSheet2 = objExcel1.ActiveWorkbook.Worksheets("Bad Data")

 objExcel1.ScreenUpdating = False
 objExcel1.Calculation = -4135  'xlCalculationManual

 IntRow2=2
 IntRow1=4
 Do Until IntRow1 > objSheet1.UsedRange.Rows.Count

  ColStart = objExcel1.Application.WorksheetFunction.Match("Parent Business Process ID", objSheet1.Rows(3), 0) + 1 

Do Until ColStart > objSheet1.UsedRange.Columns.Count And objSheet1.Cells(IntRow1,ColStart) = ""

    If objSheet1.Cells(IntRow1,ColStart + 1) > objSheet1.Cells(IntRow1,ColStart + 5) And objSheet1.Cells(IntRow1,ColStart + 5) <> "" Then
    
    objSheet1.Range(objSheet1.Cells(IntRow1,1),objSheet1.Cells(IntRow1,objSheet1.UsedRange.Columns.Count)).Copy
    objSheet2.Range(objSheet2.Cells(IntRow2,1),objSheet2.Cells(IntRow2,objSheet1.UsedRange.Columns.Count)).PasteSpecial
    IntRow2=IntRow2+1
    Exit Do
    
    End If

ColStart=ColStart+4
Loop

 IntRow1=IntRow1+1
 Loop

 objExcel1.ScreenUpdating = True
 objExcel1.Calculation = -4105   'xlCalculationAutomatic

代码 B

Option Explicit

Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objSheet2
Dim IntRow1,IntRow2
Dim Flag
Dim IntColTemp,IntRowTemp
Dim Strcmp1,Strcmp2

 Flag=0
 IntColTemp=1
 IntRowTemp=3

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

 If Err.Number <> 0 Then
     On Error GoTo 0
     Wscript.Echo "Excel application not found."
     Wscript.Quit
 End If

 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
4

1 回答 1

1

通过在两个脚本中添加类似的内容，应该可以处理两个不同的工作表：

strPathExcel1 = "D:\CopyofGEWingtoWing_latest_dump_21112012.xls"

On Error Resume Next
Set objExcel1 = GetObject(, "Excel.Application")    ' attach to running instance
If Err.Number = 429 Then                            ' if that fails
  Err.Clear
  Set objExcel1 = CreateObject("Excel.Application") ' create new instance
  If Err Then                                       ' if that still fails
    WScript.Echo Err.Description & " (0x" & Hex(Err.Number) & ")"
    WScript.Quit 1                                  ' report error and terminate
  End If
  objExcel1.Workbooks.Open strPathExcel1
End If
On Error Goto 0

但是，我怀疑这种方法能否获得足够的性能来证明额外的复杂性是合理的。

在代码 A 中替换行

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

strPathExcel1 = "D:\AravoVB\Copy of Original Scripts\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1

使用上面的代码块。

在代码 B中替换行

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

If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Excel application not found."
  Wscript.Quit
End If

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

使用上面的代码块。

于 2012-12-17T22:03:28.200 回答