excel - VBA 添え字が範囲外 - エラー 9

Question

誰かがこのコードで私を助けることができますか、範囲外の添字エラーが発生しています:

「シートの作成」の後の行は、デバッガーで黄色で強調表示されます

'Validation of year
 If TextBox_Year.Value = Format(TextBox_Year.Value, "0000") Then

 'Creating Process
'Creation of new sheet
Workbooks.Add
ActiveWorkbook.SaveAs FileName:= _
    "" & Workbooks("Temperature Charts Sheet Creator").Sheets("MENU").Cells(4, 12).Value & "Data Sheet - " & ComboBox_Month.Value & " " & TextBox_Year.Value & ".xls", FileFormat _
    :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
    False, CreateBackup:=False

'Creating of the sheets
Windows("Data Sheet - " & ComboBox_Month.Value & " " & TextBox_Year.Value & ".xls").Activate

    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "31 " & ComboBox_Month.Value
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "30 " & ComboBox_Month.Value
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "29 " & ComboBox_Month.Value

For i = 28 To 1 Step -1

    Sheets.Add
    ActiveSheet.Name = i & " " & ComboBox_Month.Value

Next

Answer 1

次の単純化を提案します。次のように、後でWorkbooks.Add添え字を付ける代わりに、からの戻り値をキャプチャします。Windows()

Set wkb = Workbooks.Add
wkb.SaveAs ...

wkb.Activate ' instead of Windows(expression).Activate

一般的な哲学のアドバイス:

Excel の組み込み: ActiveWorkbook、ActiveSheet、Selection の使用を避けます。戻り値をキャプチャし、代わりに修飾式を優先します。

ビルトインを一度だけ使用し、最も外側のマクロ (サブ) でのみ使用し、マクロの開始時にキャプチャします。

Set wkb = ActiveWorkbook
Set wks = ActiveSheet
Set sel = Selection

during および within マクロは、これらの組み込みの名前に依存せず、代わりに戻り値を取得します。

Set wkb = Workbooks.Add 'instead of Workbooks.Add without return value capture
wkb.Activate 'instead of Activeworkbook.Activate

また、修飾式を使用するようにしてください。

wkb.Sheets("Sheet3").Name = "foo" ' instead of Sheets("Sheet3").Name = "foo"

また

Set newWks = wkb.Sheets.Add
newWks.Name = "bar" 'instead of ActiveSheet.Name = "bar"

修飾式を使用します。

newWks.Name = "bar" 'instead of `xyz.Select` followed by Selection.Name = "bar" 

これらのメソッドは、一般的により適切に機能し、混乱を招く結果が少なくなり、リファクタリング時の堅牢性が向上し (メソッド内およびメソッド間でコード行を移動するなど)、Excel のバージョン間でより適切に機能します。たとえば、選択範囲は、マクロの実行中に Excel のバージョンごとに異なる方法で変更されます。

.Activateまた、より修飾された式を使用する場合は、ほとんど必要ないことに注意してください。(これは、ユーザーにとって画面のちらつきが少なくなることを意味します。) したがって、行全体Windows(expression).Activateを に置き換えるのではなく、単純に削除することができますwkb.Activate。

（また、注意：あなたが示している .Select ステートメントは寄与していないため、省略できると思います。）

(私は、Excel のマクロ レコーダが、ActiveSheet、ActiveWorkbook、Selection、および Select を使用したこの脆弱なスタイルのプログラミングを促進する役割を担っていると考えています。このスタイルには、改善の余地がたくさんあります。)

Answer 2

無効なコレクションのインデックスを参照しようとすると、添え字の範囲外エラーが発生します。

ほとんどの場合、Windowsのインデックスには実際には.xlsが含まれていません。ウィンドウのインデックスは、Excelのタイトルバーに表示されるブックの名前と同じである必要があります。

推測として、私はこれを使用してみます：

Windows("Data Sheet - " & ComboBox_Month.Value & " " & TextBox_Year.Value).Activate

Answer 3

Option Explicit

Private Sub CommandButton1_Click()
Dim mode As String
Dim RecordId As Integer
Dim Resultid As Integer
Dim sourcewb As Workbook
Dim targetwb As Workbook
Dim SourceRowCount As Long
Dim TargetRowCount As Long
Dim SrceFile As String
Dim TrgtFile As String
Dim TitleId As Integer
Dim TestPassCount As Integer
Dim TestFailCount As Integer
Dim myWorkbook1 As Workbook
Dim myWorkbook2 As Workbook


TitleId = 4
Resultid = 0

Dim FileName1, FileName2 As String
Dim Difference As Long



'TestPassCount = 0
'TestFailCount = 0

'Retrieve number of records in the TestData SpreadSheet
Dim TestDataRowCount As Integer
TestDataRowCount = Worksheets("TestData").UsedRange.Rows.Count

If (TestDataRowCount <= 2) Then
  MsgBox "No records to validate.Please provide test data in Test Data SpreadSheet"
Else
  For RecordId = 3 To TestDataRowCount
    RefreshResultSheet

    'Source File row count
    SrceFile = Worksheets("TestData").Range("D" & RecordId).Value
    Set sourcewb = Workbooks.Open(SrceFile)
    With sourcewb.Worksheets(1)
      SourceRowCount = .Cells(.Rows.Count, "A").End(xlUp).row
      sourcewb.Close
    End With

    'Target File row count
    TrgtFile = Worksheets("TestData").Range("E" & RecordId).Value
    Set targetwb = Workbooks.Open(TrgtFile)
    With targetwb.Worksheets(1)
      TargetRowCount = .Cells(.Rows.Count, "A").End(xlUp).row
      targetwb.Close
    End With

    ' Set Row Count Result Test data value
    TitleId = TitleId + 3
    Worksheets("Result").Range("A" & TitleId).Value = Worksheets("TestData").Range("A" & RecordId).Value

    'Compare Source and Target Row count
    Resultid = TitleId + 1
    Worksheets("Result").Range("A" & Resultid).Value = "Source and Target record Count"
    If (SourceRowCount = TargetRowCount) Then
       Worksheets("Result").Range("B" & Resultid).Value = "Passed"
       Worksheets("Result").Range("C" & Resultid).Value = "Source Row Count: " & SourceRowCount & " & " & " Target Row Count: " & TargetRowCount
       TestPassCount = TestPassCount + 1
    Else
      Worksheets("Result").Range("B" & Resultid).Value = "Failed"
      Worksheets("Result").Range("C" & Resultid).Value = "Source Row Count: " & SourceRowCount & " & " & " Target Row Count: " & TargetRowCount
      TestFailCount = TestFailCount + 1
    End If


    'For comparison of two files

    FileName1 = Worksheets("TestData").Range("D" & RecordId).Value
    FileName2 = Worksheets("TestData").Range("E" & RecordId).Value

    Set myWorkbook1 = Workbooks.Open(FileName1)
    Set myWorkbook2 = Workbooks.Open(FileName2)

    Difference = Compare2WorkSheets(myWorkbook1.Worksheets("Sheet1"), myWorkbook2.Worksheets("Sheet1"))
    myWorkbook1.Close
    myWorkbook2.Close


    'MsgBox Difference

    'Set Result of data validation in result sheet
    Resultid = Resultid + 1

    Worksheets("Result").Activate
    Worksheets("Result").Range("A" & Resultid).Value = "Data validation of source and target File"

    If Difference > 0 Then
        Worksheets("Result").Range("B" & Resultid).Value = "Failed"
        Worksheets("Result").Range("C" & Resultid).Value = Difference & " cells contains different data!"
        TestFailCount = TestFailCount + 1
    Else
      Worksheets("Result").Range("B" & Resultid).Value = "Passed"
      Worksheets("Result").Range("C" & Resultid).Value = Difference & " cells contains different data!"
      TestPassCount = TestPassCount + 1
    End If


  Next RecordId
End If

UpdateTestExecData TestPassCount, TestFailCount
End Sub

Sub RefreshResultSheet()
  Worksheets("Result").Activate
  Worksheets("Result").Range("B1:B4").Select
  Selection.ClearContents
  Worksheets("Result").Range("D1:D4").Select
  Selection.ClearContents
  Worksheets("Result").Range("B1").Value = Worksheets("Instructions").Range("D3").Value
  Worksheets("Result").Range("B2").Value = Worksheets("Instructions").Range("D4").Value
  Worksheets("Result").Range("B3").Value = Worksheets("Instructions").Range("D6").Value
  Worksheets("Result").Range("B4").Value = Worksheets("Instructions").Range("D5").Value
End Sub

Sub UpdateTestExecData(TestPassCount As Integer, TestFailCount As Integer)
  Worksheets("Result").Range("D1").Value = TestPassCount + TestFailCount
  Worksheets("Result").Range("D2").Value = TestPassCount
  Worksheets("Result").Range("D3").Value = TestFailCount
  Worksheets("Result").Range("D4").Value = ((TestPassCount / (TestPassCount + TestFailCount)))
End Sub