Question

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

修改的

a.vbs将更新sheet2，而b.vbs将更新sheet3.But，两张源表均为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

Answer 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

使用上面的代码块。

并行运行两个或多个.VBS脚本

1 个答案: