VBA 下标超出范围 - 错误 9

VBA Subscript out of range - error 9

提问by user1680452

Can somebody help me with this code, I am getting a subscript out of rangeerror:

有人可以帮我处理这段代码吗，我收到一个下标超出范围的错误：

The line after the 'creating the sheets is highlighted in yellow in debugger

'创建工作表后的行在调试器中以黄色突出显示

'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

回答by Erik Eidt

Suggest the following simplification: capture return value from Workbooks.Addinstead of subscripting Windows()afterward, as follows:

建议如下简化：从后面捕获返回值Workbooks.Add而不是下标Windows()，如下：

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

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

General Philosophy Advice:

一般哲学建议：

Avoid use Excel's built-ins: ActiveWorkbook, ActiveSheet, and Selection: capture return values, and, favor qualified expressions instead.

避免使用 Excel 的内置函数：ActiveWorkbook、ActiveSheet 和 Selection：捕获返回值，并支持使用限定表达式。

Use the built-ins only once and only in outermost macros(subs) and capture at macro start, e.g.

仅在最外层的宏（子）中使用内置函数一次，并在宏开始时捕获，例如

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

During and within macros do not rely on these built-in names, instead capture return values, e.g.

在宏期间和内宏不依赖于这些内置名称，而是捕获返回值，例如

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

Also, try to use qualified expressions, e.g.

另外，尝试使用限定表达式，例如

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

or

或者

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

Use qualified expressions, e.g.

使用限定表达式，例如

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

These methods will work better in general, give less confusing results, will be more robust when refactoring (e.g. moving lines of code around within and between methods) and, will work better across versions of Excel. Selection, for example, changes differently during macro execution from one version of Excel to another.

这些方法通常会更好地工作，产生更少的混乱结果，在重构时会更健壮（例如在方法内和方法之间移动代码行），并且在 Excel 版本之间会更好地工作。例如，从一个 Excel 版本到另一个版本的宏执行过程中，选择会发生不同的变化。

Also please note that you'll likely find that you don't need to .Activatenearly as much when using more qualified expressions. (This can mean the for the user the screen will flicker less.) Thus the whole line Windows(expression).Activatecould simply be eliminated instead of even being replaced by wkb.Activate.

另请注意，您可能会发现.Activate在使用更多限定表达式时几乎不需要那么多。（对于用户来说，这可能意味着屏幕闪烁更少。）因此整行Windows(expression).Activate可以简单地消除而不是被替换wkb.Activate。

(Also note: I think the .Select statements you show are not contributing and can be omitted.)

（另请注意：我认为您展示的 .Select 语句没有贡献，可以省略。）

(I think that Excel's macro recorder is responsible for promoting this more fragile style of programming using ActiveSheet, ActiveWorkbook, Selection, and Select so much; this style leaves a lot of room for improvement.)

（我认为 Excel 的宏记录器负责促进这种使用 ActiveSheet、ActiveWorkbook、Selection 和 Select 的更脆弱的编程风格；这种风格留下了很大的改进空间。）

回答by Daniel

Subscript out of Range error occurs when you try to reference an Index for a collection that is invalid.

当您尝试引用无效集合的索引时，会发生下标超出范围错误。

Most likely, the index in Windows does not actually include .xls. The index for the window should be the same as the name of the workbook displayed in the title bar of Excel.

最有可能的是，Windows 中的索引实际上并不包含 .xls。窗口的索引应与 Excel 标题栏中显示的工作簿名称相同。

As a guess, I would try using this:

作为猜测，我会尝试使用这个：

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

回答by user6349114

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