сортировать строки по нескольким сценариям

Question

Я пытаюсь сортировать строки на основе нескольких значений. В этом примере я пытаюсь разделить совпадающие "Product SN" (столбец M) и "CE Name" (столбец L), которые имеют код действия «220 - замененный компонент» (столбец N), на один лист и один без ». 220 "в другой лист.

Например

• C-666 LC011169 не имеет "220" и должен быть на одном листе
• C-958 LC011169 имеет "220" и должен быть на своем собственном листе

Я знаю, что это может показаться странным, но мне придется сортировать сотни таких позиций каждый день, и я работаю над оптимизацией процесса.

Упрощенная версия будет выглядеть следующим образом (где X = Заменено):

Чтобы пойти еще дальше, я пытаюсь объединить "коды симптомов" (столбец O) после завершения первой операции. Это моя конечная цель, где символы являются симптомами:

Answer 1

Я экспериментировал с некоторыми VBA для сортировки и копирования.

См. Связанный файл xlsm в конце для получения дополнительной информации.

Итак, у нас есть код VBA, который сортирует исходную информацию (просто копируя, не касаясь исходного списка) в три новые таблицы.

Что оно делает:

• Проходит всю оригинальную таблицу
• Копирует каждую строку в новую, предварительно определенную и существующую таблицу на другом листе.

Что он не делает:

• Проверить на дубликаты
• Создает новые таблицы

Он также включает макрос для очистки отсортированных таблиц. Это также может быть использовано для очистки таблиц перед повторной сортировкой, чтобы избежать дублирования.

Код сортировки (это, скорее всего, можно улучшить, но уже поздно):

Sub sortToTables()
    Dim i, iLastRow As Integer
    Dim oLastRow As ListRow
    Dim srcRow As Range
    Dim Replaced As String, Burn As String, Repurpose As String
    iLastRow = Worksheets("Sheet1").ListObjects("Table1").ListRows.Count

    Replaced = "220 - Replaced Component"
    Burn = "C990 - Advised to burn"
    Repurpose = "130 - Repurpose"
    Application.ScreenUpdating = False
    For i = 1 To iLastRow
        If Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13) = Replaced Then
        Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
        Set oLastRow = Worksheets("220").ListObjects("Table16").ListRows.Add
        srcRow.Copy
        oLastRow.Range.PasteSpecial xlPasteValues

        ElseIf Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13) = Burn Then
        Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
        Set oLastRow = Worksheets("C990").ListObjects("Table17").ListRows.Add
        srcRow.Copy
        oLastRow.Range.PasteSpecial xlPasteValues

        ElseIf Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13) = Repurpose Then
        Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
        Set oLastRow = Worksheets("130").ListObjects("Table18").ListRows.Add
        srcRow.Copy
        oLastRow.Range.PasteSpecial xlPasteValues
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Код для очистки таблиц:

Sub ResetTable()

Dim tbl As ListObject, tbl2 As ListObject, tbl3 As ListObject

Set tbl = Worksheets("220").ListObjects("Table16")
Set tbl2 = Worksheets("C990").ListObjects("Table17")
Set tbl3 = Worksheets("130").ListObjects("Table18")


  If tbl.ListRows.Count >= 1 Then
    tbl.DataBodyRange.Delete
  End If

  If tbl2.ListRows.Count >= 1 Then
    tbl2.DataBodyRange.Delete
  End If

  If tbl3.ListRows.Count >= 1 Then
    tbl3.DataBodyRange.Delete
  End If

End Sub

Файл:https://drive.google.com/open?id=0B_8icTMsheWfTUV0YjJCaElmTkU

РЕДАКТИРОВАТЬ

Обновите код, чтобы сделать то, что вы прокомментировали (я думаю):

Sub sortToTables()
    Dim i, iLastRow As Integer
    Dim oLastRow As ListRow
    Dim srcRow As Range
    Dim Replaced As String, Burn As String, Repurpose As String
    iLastRow = Worksheets("Sheet1").ListObjects("Table1").ListRows.Count

    Application.ScreenUpdating = False
    For i = 1 To iLastRow

        If Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 11) = "C-235" And _
            Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 12) = "LC0001234" And _
            (InStr(1, Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13), "220") Or _
            InStr(1, Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13), "221")) Then

            Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
            Set oLastRow = Worksheets("220").ListObjects("Table16").ListRows.Add
            srcRow.Copy
            oLastRow.Range.PasteSpecial xlPasteValues
        Else
            Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
            Set oLastRow = Worksheets("C990").ListObjects("Table17").ListRows.Add
            srcRow.Copy
            oLastRow.Range.PasteSpecial xlPasteValues

        End If
    Next
    Application.ScreenUpdating = True
End Sub

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

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

Я не удосужился переименовать листы, но в этом примере я использую только два листа.

Разъяснение о том, как написать оператор If - обратите внимание на круглые скобки вокруг OR:

If ref(x,y) = "string" And ref(x,y2) = "another string" And (ref(x,y3) ="this" Or (ref(x,y3) ="that") Then

   Do stuff

Else '(Or ElseIf)

   Do something else

End If