sortuj wiersze według wielu scenariuszy

Próbuję sortować wiersze na podstawie wielu wartości. W tym przykładzie próbuję rozdzielić pasujące „Produkt SN” (kolumna M) i „Nazwa CE” (kolumna L), które mają kod akcji „220 - Zastąpiony komponent” (kolumna N) w jednym arkuszu, a te bez „ 220 "w inny arkusz.

Na przykład

• C-666 LC011169 nie ma „220” i powinien znajdować się na jednym arkuszu
• C-958 LC011169 ma „220” i powinien znajdować się na własnym arkuszu

Wiem, że może to wydawać się mylące, ale będę musiał codziennie sortować setki takich elementów zamówienia i pracuję nad usprawnieniem tego procesu.

Uproszczona wersja wyglądałaby jak na poniższym obrazku (gdzie X = Zamieniono ):

Aby przejść dalej, próbuję połączyć „kody symptomów” (kolumna O) po zakończeniu pierwszej operacji. To jest mój ostateczny cel, w którym Symbole są Objawami :

Eksperymentowałem z pewnym VBA do sortowania i kopiowania.

Zobacz link do pliku xlsm na końcu, aby uzyskać więcej informacji.

Mamy więc tutaj kod VBA, który sortuje oryginalne informacje (po prostu kopiowanie, nie dotykanie oryginalnej listy) do trzech nowych tabel.

Co to robi:

• Przechodzi przez cały oryginalny stół
• Kopiuje każdy wiersz do nowej, wstępnie zdefiniowanej i istniejącej tabeli na innym arkuszu.

Czego nie robi:

• Sprawdź duplikaty
• Tworzy nowe tabele

Zawiera również makro do czyszczenia posortowanych tabel. Można to również wykorzystać do wyczyszczenia tabel przed sortowaniem po raz drugi, aby uniknąć duplikatów.

Kod sortowania (najprawdopodobniej można to poprawić, ale robi się późno):

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

Kod do czyszczenia tabel:

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

Plik: https://drive.google.com/open?id=0B_8icTMsheWfTUV0YjJCaElmTkU

EDYTOWAĆ

Zaktualizuj kod, aby zrobić to, co skomentowałeś (myślę):

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

Jak widać tutaj, używam Instrdo uzyskania częściowego dopasowania ciągu zamiast wartości bezwzględnej, ponieważ komórka zawiera więcej niż tylko liczbę.

Jeśli chcesz sprawdzić, powiedzmy, różne numery seryjne, możesz zamiast tego przypisać tę wartość do zmiennej i wprowadzić numer seryjny, który chcesz posortować w polu tekstowym.

Nie zawracałem sobie głowy zmianą nazw arkuszy, ale w tym przykładzie używam tylko dwóch arkuszy.

Wyjaśnienie, jak napisać instrukcję If - zwróć uwagę na nawias wokół 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