VBA Subscript out of range - error 9

后端 未结 3 1480
悲&欢浪女
悲&欢浪女 2020-12-02 00:35

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

\"enter

相关标签:
3条回答
  • 2020-12-02 00:53
    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
    
    0 讨论(0)
  • 2020-12-02 01:04

    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.

    As a guess, I would try using this:

    Windows("Data Sheet - " & ComboBox_Month.Value & " " & TextBox_Year.Value).Activate
    
    0 讨论(0)
  • 2020-12-02 01:09

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

    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.

    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.

    Also please note that you'll likely find that you don't need to .Activate nearly 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).Activate could simply be eliminated instead of even being replaced by wkb.Activate.

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

    (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.)

    0 讨论(0)
提交回复
热议问题