当没有可用于排序的文本时,防止排序功能失败

时间:2014-05-06 17:25:35

标签: excel vba excel-vba

所以我在下面提供的代码中遇到了一些问题。我遇到的第一个问题是,如果我在“Sheet1”中并运行代码,则会出现运行时错误“选择Range类的方法失败”。从“Sheet2”运行代码工作正常。我对VBA很新,根据我的理解,我已经定义了要选择的工作表,所以我不确定错误来自哪里。

我遇到的第二个问题是sort函数。如果源选择没有任何文本,则sort函数会失败,因为没有什么可以排序(有意义)。如果有文本,我只是不知道如何添加一个函数来对选择进行排序,如果不存在则只传递它。

我知道我提供的代码可能非常平庸,可能有更好的方法来处理同一组数据。我欢迎任何更好地简化和管理此代码的建议。

Sub DaysCalc()
'Day 1
    ToColumn Sheets("Sheet1").Range("B4:AD22"), _
                         Sheets("Sheet2").Range("A2")

    Sheets("Sheet2").Range("A2:A552").Select
    Selection.sort Key1:=Sheets("Sheet2").Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

    Application.DisplayAlerts = False

    Sheets("Sheet2").Range("A2:A552").Select
    Selection.TextToColumns Destination:=Sheets("Sheet2").Range("B2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    Array(7, 1))


End Sub


Sub ToColumn(rngIn As Range, topCell As Range)

    Dim rv() As Variant, n As Long, d, r As Long, c As Long
    Dim nR As Long, nC As Long, i As Long

    d = rngIn.Value
    nR = UBound(d, 1)
    nC = UBound(d, 2)
    n = nR * nC
    ReDim rv(1 To n, 1 To 1)
    i = 0
    For r = 1 To nR
    For c = 1 To nC
        i = i + 1
        rv(i, 1) = d(r, c)
    Next c
    Next r

    topCell.Resize(n, 1).Value = rv
End Sub

1 个答案:

答案 0 :(得分:0)

错误"选择Range类的方法失败。"在Sheet1上运行它是因为行Sheets("Sheet2").Range("A2:A552").Select试图选择一个不在Active Worksheet上的范围。您无需实际选择要进行排序的区域,可以使用Sheets("Sheet2").Range("A2:A552").Sort Key1:=Sheets("Sheet2").Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

尝试对空范围进行排序时,我没有收到错误,但是,当我尝试使用Text to Columns函数时,我收到它。我建议在它之前添加On Error Resume Next以避免此问题。