Как учитывать пустые ячейки при использовании ссылок на ячейки для прямого VBA

Question

У меня есть данные в таблице, где я сравниваю два столбца J и T. Значения, которые могут принимать J и T, включают A2B, APL, BGF, CMA, среди прочих (см. Код).

Если эти значения равны, скопируйте строку i в лист с именем только что отмеченных ячеек.

Если эти значения не равны, скопируйте строку i в листы с именем только что отмеченных ячеек.

Пример : сравнить J2 и T2,

Предположим, J2 = T2 = BGF, затем скопировать строку 2 и вставить в sheet("BGF")

Далее сравните J3 и T3

Предположим, J3 = BGF и T3 = CMA, скопируйте строку 3 и вставьте в sheet(BGF) и sheet(CMA)

Продолжить для J4 et c ...

Проблема : при запуске этого кода, если J3 = BGF и T3 = ничего (пусто), тогда код выдает ошибку.

Аналогично, если все ячейки имеют значения, программа выдает ошибку времени выполнения в конце набора данных, а не останавливается программа.

Вот мой код

Sub Sortdata()
'step 1 clear all data
Sheets("A2B").Cells.ClearContents
Sheets("APL").Cells.ClearContents
Sheets("BGF").Cells.ClearContents
Sheets("CMA").Cells.ClearContents
Sheets("K Line").Cells.ClearContents
Sheets("MacAndrews").Cells.ClearContents
Sheets("Maersk").Cells.ClearContents
Sheets("OOCL").Cells.ClearContents
Sheets("OPDR").Cells.ClearContents
Sheets("Samskip").Cells.ClearContents
Sheets("Unifeeder").Cells.ClearContents

Dim i As Long
With Worksheets("All Data")
    For i = 2 To 10000
        If .Range("J" & i) = .Range("T" & i) Then 'if two cells are equal
            .Rows(i).Copy
            Worksheets(.Range("J" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats ' paste the value at the end of the row.
        Else
            .Rows(i).Copy
            Worksheets(.Range("J" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats ' paste the value at the end of the row.
            .Rows(i).Copy
            Worksheets(.Range("T" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
        End If
    Next i
End With

End Sub

Answer 1

Ваша проблема заключается в том, что, когда вы ударяете пустую ячейку, вы пытаетесь сослаться на рабочий лист как

Worksheets("")

, что, конечно, не помогает. Поэтому вам нужно избегать этих ссылок.

Вот как бы я это сделал

Sub Sortdata()
    'step 1 clear all data
    Sheets("A2B").Cells.ClearContents
    Sheets("APL").Cells.ClearContents
    Sheets("BGF").Cells.ClearContents
    Sheets("CMA").Cells.ClearContents
    Sheets("K Line").Cells.ClearContents
    Sheets("MacAndrews").Cells.ClearContents
    Sheets("Maersk").Cells.ClearContents
    Sheets("OOCL").Cells.ClearContents
    Sheets("OPDR").Cells.ClearContents
    Sheets("Samskip").Cells.ClearContents
    Sheets("Unifeeder").Cells.ClearContents

    Dim i As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim LastRow As Long


    With Worksheets("All Data")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastRow
            If IsEmpty(.Range("J" & i)) Then
                Set ws1 = Nothing
            Else
                Set ws1 = Worksheets(.Range("J" & i).Value)
            End If
            If IsEmpty(.Range("T" & i)) Then
                Set ws2 = Nothing
            Else
                Set ws2 = Worksheets(.Range("T" & i).Value)
            End If

            If ws1 Is Nothing Then
                If Not ws2 Is Nothing Then
                    CopyToWs ws2, .Rows(i)
                End If
            ElseIf ws2 Is Nothing Then
                If Not ws1 Is Nothing Then
                    CopyToWs ws1, .Rows(i)
                End If
            Else
                CopyToWs ws1, Rows(i)
                If ws1.Name <> ws2.Name Then
                    CopyToWs ws2, .Rows(i)
                End If
            End If
        Next
    End With

End Sub

Sub CopyToWs(ws As Worksheet, rng As Range)
    rng.Copy
    ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.PasteSpecial xlPasteValuesAndNumberFormats
End Sub