Question

我在行上“下标超出范围”错误：

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

Answer 1

找出问题所在。 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

Subcipt超出范围我第一次运行它但在下次运行时不会出错

1 个答案: