Перенос данных между листами 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

В дополнение к тому, что сказал @Ekkehard.Horner, вы не можете использовать объект Excel после выхода, поэтому вы должны получить ошибку при попытке открыть Data.xls,

oExcel.Workbooks.Close
oExcel.Quit

'writes to Graph sheet
set oBook = oExcel.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 заявление). С точки зрения обработки лучше всего закрывать / отбрасывать объекты в том же контексте, в котором они были созданы (если это возможно). Помогает избежать попыток использовать объекты до того, как они были созданы или после того, как они были уничтожены.

Для дальнейшей оптимизации вашего сценария вы можете даже избежать промежуточных переменных 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

Answer 2

Повторное использование одной и той же переменной управления циклом (count) во вложенных циклах недопустимо:

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

Так что ваш код даже не скомпилируется.