在 Excel 个工作表之间传输数据

Question

这是我的脚本，它打开 Excel 文件并从一些单元格中获取信息，然后将其插入到另一个 Excel 文档中。我已经包括了整个脚本，但标记了我认为错误的地方。我真的很困惑为什么这不起作用，因为我在另一个完美运行的脚本中使用完全相同的方法。

根据答案更新了代码，同样的问题仍然存在。我认为这是由 Find_Excel_Row.

引起的

我尝试将脚本放入循环中的函数中，因此变量没有问题，但我遇到了同样的错误。

Dim FSO             'File system Object
Dim folderName      'Folder Name
Dim FullPath        'FullPath
Dim TFolder         'Target folder name
Dim TFile           'Target file name
Dim TFileC          'Target file count
Dim oExcel          'The Excel Object
Dim oBook1          'The Excel Spreadsheet object
Dim oBook2
Dim oSheet          'The Excel sheet object
Dim StrXLfile       'Excel file for recording results
Dim bXLReadOnly     'True if the Excel spreadsheet has opened read-only
Dim strSheet1       'The name of the first Excel sheet
Dim r, c            'row, column for spreadsheet
Dim bFilled         'True if Excel cell is not empty
Dim iRow1           'the row with lower number in Excel binary search
Dim iRow2           'the row with higher number in Excel binary search
Dim iNumpasses      'Number of times through the loop in Excel search
Dim Stock           'product stock levels
Dim ID              'product ID 
Dim Target          'Target file
Dim Cx              'Counter
Dim Cxx             'Counter 2
Dim RR, WR          'Read and Write Row

Call Init

Sub Init
  Set FSO = CreateObject("Scripting.FileSystemObject")

  FullPath = FSO.GetAbsolutePathName(folderName) 

  Set oExcel = CreateObject("Excel.Application")

  Target2 = CStr("D:\Extractor\Results\Data.xls")

  Set oBook2 = oExcel.Workbooks.Open(Target2)

  TFolder = InputBox ("Target folder")
  TFile   = InputBox ("Target file")
  TFileC  = InputBox ("Target file count")

  Call Read_Write
End Sub

Sub Read_Write
  RR = 6
  PC = 25

  For Cx = 1 to Cint(TFileC)
    Target  = CStr("D:\Extractor\Results\"& TFolder & "\"& TFile & Cx &".html")

    For Cxx = 1 to PC
      Call Find_Excel_Row

      Set oBook1 = oExcel.Workbooks.Open(Target)

      Set Stock  = oExcel.Cells(RR,5)
      Set ID     = oExcel.Cells(RR,3)

      MsgBox ( Cxx &"/25 " &" RR: "& RR & " ID: " & ID & " Stock: " & Stock )

      oBook1.Close

      MsgBox "Writing Table"
      oExcel.Cells(r,4).value = Stock            '<<<  Area of issue
      oExcel.Cells(r,2).value = ID               '<<<

      oBook2.Save
      oBook2.Close

      Cxx = Cxx + 1
      RR = RR + 1
    Next
    Cx = Cx + 1
  Next

  MsgBox "End"

  oExcel.Quit
End sub

Sub Find_Excel_Row
  bfilled     = False
  iNumPasses  = 0
  c           = 1
  iRow1       = 2
  iRow2       = 10000

  Set oSheet = oBook2.Worksheets.Item("Sheet1")

  'binary search between iRow1 and iRow2
  Do While (((irow2 - irow1)>3) And (iNumPasses < 16))
    'Set current row
    r = Round(((iRow1 + iRow2) / 2),0)

    'Find out if the current row is blank
    If oSheet.Cells(r,c).Value = "" Then
      iRow2 = r + 1
    Else
      iRow1 = r - 1
    End If

    iNumPasses = iNumPasses + 1
  Loop

  r = r + 1

  'Step search beyond the point found above
  While bFilled = False
    If oSheet.Cells(r,c).Value = "" Then
      bFilled = True
    Else
      r = r + 1
    End If
  Wend

  oExcel.Workbooks.Close
End Sub

Answer 1

在嵌套循环中重复使用相同的循环控制变量（计数）是非法的：

Option Explicit

Dim bad_loop_counter
For bad_loop_counter = 1 To 2
    WScript.Echo "outer", bad_loop_counter
    For bad_loop_counter = 1 To 2
        WScript.Echo "inner", bad_loop_counter
    Next
Next

输出：

cscript 32246593.vbs
... 32246593.vbs(6, 26) Microsoft VBScript compilation error: Invalid 'for' loop control variable

因此您的代码甚至无法编译。

Answer 2

除了说的，退出后不能使用Excel对象，所以打开Data.xls时应该会报错。

oExcel.Workbooks.Close
<b>oExcel.Quit</b>

'writes to Graph sheet
set oBook = <b>oExcel</b>.Workbooks.Open("D:\Extractor\Results\Data.xls")
'           ^^^^^^ This should be giving you an error
'Writing Table
MsgBox "Writing Table"
oExcel.Cells(r,4).value = Stock       <<< Error here
oExcel.Cells(r,2).value = ID          <<<

实际上，您在脚本中的多个位置关闭了应用程序。不要那样做。创建 Excel 实例一次，在整个脚本中使用这个实例，并在脚本结束时终止它。

编辑：这就是导致您出现问题的原因：

Set Stock  = oExcel.Cells(RR,5)
Set ID     = oExcel.Cells(RR,3)
...
oBook1.Close
...
oExcel.Cells(r,4).value = Stock            '<<<  Area of issue
oExcel.Cells(r,2).value = ID               '<<<

您将 Range 个对象（由 Cells 属性返回）分配给变量 Stock 和 ID，但随后使用这些对象引用的数据。

既然你无论如何都想传递值，请将各个单元格的值分配给变量 Stock 和 ID:

Stock  = oExcel.Cells(RR,5).Value
ID     = oExcel.Cells(RR,3).Value

此外，我建议避免使用应用程序对象的 Cells 属性。而是使用包含数据的实际工作表的相应属性，这样您所指的内容就会变得更加明显：

Stock  = oBook1.Sheets(1).Cells(RR,5).Value
ID     = oBook1.Sheets(1).Cells(RR,5).Value

在您修复该问题后，您很可能会运行进入下一期，内容如下：

oBook2.Save
oBook2.Close

您正在循环中关闭 oBook2 而没有退出循环。这应该会在下一次迭代中引发错误（当您尝试将下一个值分配给已经关闭的工作簿时）。将上述两个语句移出循环，或者更好的是，将它们移至 Init 过程（在 Call Read_Write 语句之后）。从处理的角度来看，最好 close/discard 对象在创建它们的相同上下文中（如果可能）。有助于避免在创建对象之前或销毁对象之后尝试使用对象。

为了进一步优化您的脚本，您甚至可以避免中间变量 Stock 和 ID 并直接传输值：

oBook2.Sheets(1).Cells(r,4).value = oBook1.Sheets(1).Cells(RR,5).Value
oBook2.Sheets(1).Cells(r,2).value = oBook1.Sheets(1).Cells(RR,5).Value

在 Excel 个工作表之间传输数据

Transferring data between Excel sheets

vbscript

excel.application