Subscipt超出範圍，我第一次運行它，但並不會給下次運行錯誤

-1

我得到「下標越界」錯誤在線：Subscipt超出範圍，我第一次運行它，但並不會給下次運行錯誤

Set DataSheet = Worksheets(DataSheetName)

這只是發生在我第一次運行它。如果在錯誤發生後重新運行代碼，則宏工作正常。

完整代碼：

Sub iGetData() 

Dim ValidatorWB As Workbook 
Dim PopDetail As Worksheet 
Dim DataSheetName As String 
Dim DataWB As Workbook 
Dim DataSheet As Worksheet 
Dim Ret 
Dim DWBName As String 
Dim FNOrder As String 
Dim FNOrdCol As String 

Set PopDetail = Worksheets("PopulateWireframe") 
Set ValidatorWB = Workbooks(ActiveWorkbook.Name) 
DataSheetName = Range("F18").Value 
FNOrder = Range("F33").Value 

Application.ScreenUpdating = False 

'Open data file 
Ret = IsWorkBookOpen(PopDetail.Range("C18").Value) 
If Ret = False Then 

Workbooks.Open PopDetail.Range("C18").Value 
DataFileName = ActiveWorkbook.Name 
Set DataWB = Workbooks(DataFileName) 
Set DataSheet = Worksheets(DataSheetName) 

Dim FilterColumn As String 
Dim FilterCriteria As String 
Dim ColumnNumber As Integer 

'Set filter 
With DataSheet 
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then 
    ActiveSheet.ShowAllData 
End If 
End With 

ValidatorWB.Activate 
PopDetail.Activate 

For x = 21 To 30 

If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then 

    FilterColumn = PopDetail.Range("E" & x).Value 
    FilterCriteria = PopDetail.Range("F" & x).Value 

    DataWB.Activate 
    DataSheet.Activate 

    DataSheet.Range("A1").Select 

    Selection.End(xlToLeft).Select 

    ActiveCell.Rows("1:1").EntireRow.Select 

    Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 

    ColumnNumber = ActiveCell.Column 

    DataSheet.AutoFilterMode = False 
    DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria 

End If 

    ValidatorWB.Activate 
    PopDetail.Activate 

'x = x + 1 

Next x 

    DataWB.Activate 
    DataSheet.Activate 

    'Alpahebtical order 
    DataSheet.Range("A1").Select 
    ActiveCell.Rows("1:1").EntireRow.Select 
    Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 
    FNOrdCol = ActiveCell.Address 
    ActiveSheet.Sort.SortFields.Clear 
    ActiveSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _ 
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

    With ActiveSheet.Sort 
     .SetRange DataSheet.Cells 
     .header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    'Copy data 
    Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 

    'Paste data to validator 
    ValidatorWB.Activate 
    ValidatorWB.Sheets.Add().Name = "ValidatorData" 
    ActiveCell.Offset(3, 0).Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=True 
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15 
    Application.CutCopyMode = False 

'DataWB.Close savechanges:=False 
If DataWB.Windows(1).Visible = True Then 
DataWB.Windows(1).Visible = False 
End If 

Application.ScreenUpdating = True 

PopDetail.Activate 

Else 

DWBName = GetFilenameFromPath(PopDetail.Range("C18").Value) 
Set DataWB = Workbooks(DWBName) 
DataWB.Activate 
Set DataSheet = Worksheets(DataSheetName) 
DataSheet.Activate 
With DataSheet 
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then 
    ActiveSheet.ShowAllData 
End If 
End With 

ValidatorWB.Activate 
PopDetail.Activate 

For x = 21 To 30 

If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then 

    FilterColumn = PopDetail.Range("E" & x).Value 
    FilterCriteria = PopDetail.Range("F" & x).Value 

    DataWB.Activate 
    DataSheet.Activate 

    DataSheet.Range("A1").Select 

    Selection.End(xlToLeft).Select 

    ActiveCell.Rows("1:1").EntireRow.Select 

    Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 

    ColumnNumber = ActiveCell.Column 

    DataSheet.AutoFilterMode = False 
    DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria 

End If 

    ValidatorWB.Activate 
    PopDetail.Activate 

'x = x + 1 

Next x 

    DataWB.Activate 
    DataSheet.Activate 

    'Alpahebtical order 
    DataSheet.Range("A1").Select 
    ActiveCell.Rows("1:1").EntireRow.Select 
    Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 
    FNOrdCol = ActiveCell.Address 
    ActiveSheet.Sort.SortFields.Clear 
    ActiveSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _ 
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

    With ActiveSheet.Sort 
     .SetRange DataSheet.Cells 
     .header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    'Copy data 
    Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 

    'Paste data to validator 
    ValidatorWB.Activate 
    ValidatorWB.Sheets.Add().Name = "ValidatorData" 
    ActiveCell.Offset(3, 0).Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=True 
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15 
    Application.CutCopyMode = False 

'DataWB.Close savechanges:=False 
If DataWB.Windows(1).Visible = True Then 
DataWB.Windows(1).Visible = False 
End If 

Application.ScreenUpdating = True 

PopDetail.Activate 

End If 

End Sub

來源

2015-06-11 Tanzir Rahman

檢查我的評論在你前面的問題對此非常相同的代碼行。 – Jeeped

當我設置DataSheet = DataWB.Worksheets（DataSheetName）時，仍然出現相同的錯誤。在我發佈之前，我曾嘗試過。 –

請注意我在這篇文章中提到的：這隻發生在我第一次運行它。如果在錯誤發生後重新運行代碼，則宏工作正常。 –

想通了這個問題。 Excel通常會將新打開的工作簿設置爲活動工作簿，這就是爲什麼我使用activeworkbook.name來定義工作簿，但新打開的工作簿未被設置爲活動工作簿的原因。

這樣做：

Workbooks.Open PopDetail.Range("C18").Value 
DataFileName = GetFilenameFromPath(PopDetail.Range("C18").Value) 
Set DataWB = Workbooks(DataFileName) 
DataWB.Activate 
Set DataSheet = Worksheets(DataSheetName)

相反的：

Workbooks.Open PopDetail.Range("C18").Value 
DataFileName = ActiveWorkbook.Name 
Set DataWB = Workbooks(DataFileName) 
Set DataSheet = Worksheets(DataSheetName)

用GetFileName代碼：

Function GetFilenameFromPath(ByVal strPath As String) As String 
' Returns the rightmost characters of a string upto but not including the rightmost '\' 
' e.g. 'c:\winnt\win.ini' returns 'win.ini' 

    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then 
     GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1) 
    End If 
End Function

來源

2015-06-12 13:07:33

Subscipt超出範圍，我第一次運行它，但並不會給下次運行錯誤

回答

相關問題