0

a.vbs と b.vbs という 2 つの .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

両方のスクリプトに次のようなものを入れることで、2つの異なるシートでの作業が可能になるはずです。

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 に答える