☰

按多种场景对行进行排序

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 worksheet-function
按多种场景对行进行排序

我正在尝试根据多个值对行进行排序。在此示例中，我尝试将匹配的“产品 SN”（M 列）和“CE 名称”（L 列）分离到一张工作表中，并将不包含“220 - 更换组件”操作代码（N 列）的分离到另一张工作表中。

例如

  • C-666 LC011169 没有“220”，应该在一张纸上
  • C-958 LC011169 有一个“220”，应该在其自己的表格上

示例 Excel

我知道这可能看起来令人困惑，但我每天必须对数百个这样的项目进行分类，而且我正在努力简化这个过程。

简化版本如下图所示（其中X=已替换)：

在此处输入图片描述

为了更进一步，我尝试在第一个操作完成后合并“症状代码”（O 列）。这是我的最终目标，其中象征即症状：

在此处输入图片描述

答案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

相关内容