Как использовать значение ячейки, чтобы открыть указанный лист c?

Question

Во-первых, спасибо за помощь! Я учусь пользоваться VBA и получаю от этого удовольствие, но теперь я столкнулся с трудностями, надеюсь, ваши знания помогут мне в трудную минуту.

Справочная информация : я у меня есть данные в таблице, где я сравниваю два столбца J и T.

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

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

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

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

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

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

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

КОД

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

' Look at rows J and T, if the values are equal then copy row i to sheet "Cell( i , J )".
' Else, copy row i to sheet(Cell( i , J )) and sheet(Cell ( i , T ))             [Value.Ji and Value.Ti]

Sheets("All Data").Select

Dim i As Integer

For i = 2 To 10000
    If Worksheets("All Data").Range("J" & i) = Worksheets("All Data").Range("T" & i) Then 'if two cells are equal

        Worksheets("All Data").Rows(i).Select 'then select the row
        Selection.Copy
        Worksheets("All Data").Rows(i).Copy 'copy the data
        Worksheets(Sheets("All Data").Range("J" & i).Value).End(xlUp).Select 'open the new worksheet using the cell value Ji as the sheet name
        Selection.Offset(1, 0).Select
        ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats ' paste the value at the end of the row.

        Else
        Worksheets("All Data").Rows(i).Select
        Selection.Copy
        Worksheets("All Data").Rows(i).Copy
        Worksheets(Sheets("All Data").Range("J" & i).Value).End(xlUp).Select
        Selection.Offset(1, 0).Select
        ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats

        Worksheets("All Data").Rows(i).Select
        Selection.Copy
        Worksheets("All Data").Rows(i).Copy
        Worksheets(Sheets("All Data").Range("T" & i).Value).End(xlUp).Select
        Selection.Offset(1, 0).Select
        ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats

    End If
Next i

End Sub

Answer 1

Посмотрите, работает ли это. Вы можете увидеть, насколько код может быть сокращен на , избегая Select.

Sub Sortdata()

'code to clear sheets

Dim i As Long

With Worksheets("All Data")
    For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
        If Len(.Range("J" & i)) > 0 And Len(.Range("T" & i)) > 0 Then
            .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.
            If .Range("J" & i) <> .Range("T" & i) Then
                .Rows(i).Copy
                Worksheets(.Range("T" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            End If
        End If
    Next i
End With

End Sub