Пропустить несоответствие типов - PullRequest
0 голосов
/ 06 ноября 2018

в строке «Value =» в цикле есть экземпляры, где я столкнусь с несоответствием типов или пустыми ячейками.

Может ли кто-нибудь объяснить, как я могу использовать тест на ошибки, чтобы пропустить этот шаг и продолжить мой цикл, если в наборе данных есть ошибка?

Спасибо!

Sub ExpDate()

Dim bRow As Double
Dim tRow As Double
Dim lCol As Double
Dim fCol As Double
Dim ListRow As Double

Dim Value As Date

With ThisWorkbook.Worksheets("Canadian")

bRow = Cells(Rows.Count, 5).End(xlUp).row
tRow = 5
fCol = 7

Do While tRow <= bRow
    lCol = Cells(tRow, Columns.Count).End(xlToLeft).Column

    Do While fCol <= lCol


        Value = Cells(tRow, fCol).Value

        ListRow = Cells(Rows.Count, 1).End(xlUp).row + 1
        Cells(ListRow, 1).Value = Value


    fCol = fCol + 1
    Loop

fCol = 7
tRow = tRow + 1
Loop


Range("A5:A1000").RemoveDuplicates Columns:=Array(1, 1), Header:=xlYes

End With

End Sub

Ответы [ 2 ]

0 голосов
/ 06 ноября 2018

Представьте, что ваш ввод выглядит как столбец A, и вы хотите передать даты в столбец B:

enter image description here

Есть две проблемы, которые следует учитывать - ячейки в строке 3 и строке 5. Строка 5 может быть легко проверена, поскольку это ошибка, и ?IsError(Cells(5,1) вернет True. Однако, если кто-то попытается проверить ?IsError(Cdate("K")), возникнет проблема.

Быстрый способ исправить это - специальная логическая функция с On Error Resume Next, возвращающая True, если в разговоре CDate(value) есть какая-либо конкретная ошибка:

Sub TestMe()

    Dim target As Range
    Dim myCell As Range
    Set target = Worksheets(1).Range("A1:A6")

    For Each myCell In target
        If IsCellDate(myCell) Then
            Dim someDate As Date
            someDate = myCell
            myCell.Offset(0, 1) = someDate
        End If
    Next

End Sub

Public Function IsCellDate(myData As Variant) As Boolean

    On Error Resume Next '- use this line really with caution!

    If IsError(CDate(myData)) Then
        IsCellDate = False
        Exit Function
    End If
    IsCellDate = True

End Function

Или вы можете использовать IsDate() и избежать пользовательской функции, как в этот ответ .

0 голосов
/ 06 ноября 2018

Несколько вещей.

Вам просто нужно проверить, содержит ли ячейка дату.

Используйте Long для целочисленных переменных, а не Double.

Ваше утверждение With было излишним, так как вам нужно использовать точки перед ссылками диапазона - я их добавил.

Sub ExpDate()

Dim bRow As Long
Dim tRow As Long
Dim lCol As Long
Dim fCol As Long
Dim ListRow As Long
Dim Value As Date

With ThisWorkbook.Worksheets("Canadian")
    bRow = .Cells(Rows.Count, 5).End(xlUp).Row
    tRow = 5
    fCol = 7

    Do While tRow <= bRow
        lCol = .Cells(tRow, Columns.Count).End(xlToLeft).Column
        Do While fCol <= lCol
            If IsDate(.Cells(tRow, fCol).Value) Then
                ListRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Cells(ListRow, 1).Value = .Cells(tRow, fCol).Value
                fCol = fCol + 1
            End If
        Loop
        fCol = 7
        tRow = tRow + 1
    Loop
    .Range("A5:A1000").RemoveDuplicates Columns:=Array(1, 1), Header:=xlYes
End With

End Sub
...