Сортировка рабочих таблиц в Excel с VBA с использованием имен в качестве дат

Question

Я пишу пользовательскую процедуру сортировки для моей электронной таблицы Excel, которая имеет по крайней мере 3 рабочих листа.На первую позицию я ставлю лист «Сводка», на второй - «Данные», а остальные - на листы с именами дат «17.03.2011», «20.03.2011» и т. Д. Их необходимо отсортировать в хронологическом порядке.

Вот что у меня есть, скрипт останавливается с ошибкой «Требуется объект» в строке с DateDiff (), и я понятия не имею, почему: После исправления кода ниже у меня все еще возникают проблемысделать вещь сортировать в правильном порядке.Кто-нибудь может предложить способ сравнения и перемещения по листам?

Public Sub ssort()
sSummary.Move before:=Worksheets.Item(1)
sData.Move after:=sSummary
Dim i, n As Integer
Dim diff As Long
Dim current, other As Worksheet

For i = 1 To Worksheets.Count
    Set current = Worksheets.Item(i)
    If current.Name <> sData.Name And current.Name <> sSummary.Name Then

        For n = i + 1 To Worksheets.Count
            Set other = Worksheets.Item(n)
            diff = DateDiff(DateInterval.day, Format(current.Name, "dd.mm.yyyy"), Format(other.Name, "dd.mm.yyyy"))
            If diff > 0 Then
                current.Move before:=other
                Debug.Print "Moving " & current.Name & " before " & other.Name
            ElseIf diff < 0 Then
                current.Move after:=other
                Debug.Print "Moving " & current.Name & " after " & other.Name
            End If
        Next n

    End If
Next i
End Sub

Я думаю, что я либо не понимаю DateDiff () или Format (), может кто-нибудь, пожалуйста, пролить светна это?

После изменения кода из онлайн-примера здесь http://www.vbaexpress.com/kb/getarticle.php?kb_id=72, чтобы использовать датировку для сравнения, я пришел к этому решению, которое работает, как предполагалось:

Sub sort2()
sSummary.Move before:=Worksheets.Item(1)
sData.Move after:=sSummary
Dim n As Integer
Dim M As Integer
Dim dsEnd, lowest As Integer
Dim dCurrent() As String
Dim dOther() As String
Dim diff As Long
dsStart = 3
dsEnd = Worksheets.Count

For M = dsStart To dsEnd
    For n = M To dsEnd
        If Worksheets(n).Name <> "Summary" And Worksheets(n).Name <> "Data" And Worksheets(M).Name <> "Summary" And Worksheets(M).Name <> "Data" Then
            dCurrent = Split(CStr(Worksheets(n).Name), ".")
            dOther = Split(CStr(Worksheets(M).Name), ".")
            diff = DateDiff("d", DateSerial(dCurrent(2), dCurrent(1), dCurrent(0)), DateSerial(dOther(2), dOther(1), dOther(0)))
            If diff > 0 Then
                Worksheets(n).Move before:=Worksheets(M)
            End If
        End If
    Next n
Next M

End Sub

Answer 1

Если вы удалили этот код из Интернета, имейте в виду, что DateInterval - это не нативный объект Excel или объект VBA, а объект .Net.Вы можете просто заменить «d» на «DateInterval.day».

diff = DateDiff("d", Format(current.Name, "dd.mm.yyyy"), _
                Format(other.Name, "dd.mm.yyyy"))

Answer 2

Функция DateDiff требует, чтобы два аргумента даты имели тип Variant (Date). Вместо этого вы даете ему два String аргумента, что и возвращает функция Format.

Вам необходимо преобразовать каждую строку в Variant (Date). Это можно сделать так:

strDate = current.Name ' String: "20.03.2011"
aintDateElements = Split(strDate, ".") ' Array: {2001, 03, 20}
varDate = DateSerial(aintDateElements(2), aintDateElements(1), 
    aintDateElements(0)) ' Variant (Date)

Существуют и другие способы сделать это преобразование, но я считаю, что этот способ реже дает неожиданные результаты!

Answer 3

Если вы получаете сообщения об ошибках в вызовах Format / Datediff, попробуйте разделить их на отдельные операторы. Вы увидите, в чем проблема.

Пример:

        dtStart = CDate(Format(current.Name, "dd.mm.yyyy"))
        dtEnd = CDate(Format(other.Name, "dd.mm.yyyy"))

        diff = DateDiff("d", dtStart, dtEnd)