0

これは、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
4

2 に答える 2

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

したがって、コードはコンパイルされません。

于 2015-08-27T10:34:55.110 に答える