☰

在 Excel 中筛选和重新排序列

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2007
在 Excel 中筛选和重新排序列

我有一个服务（phplist，一个新闻通讯管理器），可以导出包含多个字段的用户列表。最后，每个用户都有一个或多个他订阅的列表。

问题是，该表的排序不符合我的要求，并且不是为每个列表创建新列，而是每行都创建所需的列。这是一个例子：

源表

例如，如果我有八份新闻通讯（列表），我希望能够在 Excel 中将该表转换为一个可以创建正确列并填充数据的表。上一个表转换的结果将是这样的：

命运表

或者类似的东西（不是“是”或空白，我可以使用“是”和“否”，等等）。这样，我可以通过列表过滤表格，而这在当前表格中是不可能的：如您所见，源表中的列可以在每行包含不同的列表。这在 Excel 中可行吗？

最终解决方案：

感谢 W_Whalley，我找到了问题的真正答案。如果有人使用过 PHPList，这个新闻通讯管理器允许您下载订阅用户的列表，但正如我在原始问题中提到的那样，它不会以良好的方式为您提供他们订阅的列表。事实上，它为您提供了一个最终列，所有列表都位于同一个单元格中。这与我考虑的问题略有不同，因为该表的一行将是：

Name | Surname |     Email    |    Lists

John | Perry | [email protected] | List1 List3 List6 List 7

并不是

Name | Surname |     Email    |    Lists

John | Perry | [email protected] | List1 |  List3 | List6 | List 7

我建议使用第二张表，因为我认为它更容易管理，但事实并非如此。事实上，从 PHPList 导出用户列表后，我不得不做一些修改，为每个列表获取不同的列。这不是必要的。

我立即导出了用户列表，解决方案是应用 W_Whalley 建议的公式，一次只考虑一列。对多列执行此操作有效。最终公式（使用示例行和列）为：

=IF(ISERROR(SEARCH(L$1,$D2)),"no","yes")

或者，在西班牙语版本的 Excel（我正在使用的）中有一个示例列：

=SI(ESERROR(HALLAR($AJ$1;$AI27));"";"SI")

希望这对某些人有用。谢谢大家，特别是 W_Whalley！！

答案1

这是一个非 VBA 解决方案。假设您最多有 8 个列表（您可以根据需要进行调整），并且为了方便起见，您开始使用的表格从单元格 A1 开始。将列表的字符串名称放在单元格 L1 到 S1 中。在单元格 L2 中输入此公式 =IF(ISERROR(SEARCH(L$1,$D2&$E2&$F2&$G2&$H2&$I2&$J2&$K2)),"no","yes") 将此公式从 L1 复制到 S2，然后向下复制到您需要的位置。

它的作用：SEARCH("listN",[concatenated "list1...list8"]) 返回字符串匹配部分的起始索引号，如果未找到，则返回 #VALUE 错误（至少在 LibreOffice 中如此……抱歉，没有 Excel 可供测试）。如果出现错误，ISERROR 函数返回“no”，如果没有错误，即如果在连接的列表名称中找到字符串“listN”，则返回“yes”。

然后，您可以使用自动过滤功能过滤表格。似乎可以处理 60,000 行。

答案2

如果公式解决方案不能满足您的要求，这是一个 VBA 解决方案。

我把代码分成了小块，这样我就可以分别解释它们。我包括了 Debug.Print 命令，这样你就可以理解每个块在做什么。我希望我的解释水平是正确的。

Option Explicit
' "Option Explicit" means you have to explicitly declare every variable
' but you will get a "variable not declared" warning if you try to run
' your code with a misspelt variable.

Sub Rearrange()

  Dim ColOldCrnt As Integer
  Dim ColOldMax As Integer
  Dim RowCrnt As Long         ' Long in case there are more than 32767 rows
  Dim RowMax As Long          ' Use same row variable for both sheets
  Dim SheetOld() As Variant

  ' The first block of code (down to "Debug.Assert False") assumes your
  ' current list is in worksheet "Sheet1".  Change the "With Sheets()"
  ' command as necessary.

  ' The code finds the bottommost row and the rightmost column and then
  ' loads the entire rectangle to array SheetOld.  It is much faster using an
  ' array than accessing individual cells as necessary.

  With Sheets("Sheet1")
    RowMax = .Cells.Find("*", .Range("A1"), xlFormulas, , _
                                               xlByRows, xlPrevious).Row
    ColOldMax = .Cells.Find("*", .Range("A1"), xlFormulas, , _
                                         xlByColumns, xlPrevious).Column
    SheetOld = .Range(.Cells(1, 1), .Cells(RowMax, ColOldMax)).Value
  End With

  Debug.Print "Max row = " & RowMax
  Debug.Print "Max col = " & ColOldMax

  Debug.Print "First 15 rows from old sheet"
  For RowCrnt = 1 To 15
    For ColOldCrnt = 1 To ColOldMax
      ' With two dimensional arrays it is normal to have the column as the
      ' first dimension.  With arrays loaded from a worksheet, the row is
      ' the first dimension.
      Debug.Print "|" & SheetOld(RowCrnt, ColOldCrnt);
    Next
    Debug.Print "|"
  Next

  Debug.Assert False     ' This stops the routine until you press continue (F5)
                         ' Press Ctrl+G if you cannot see the Immediate Window.

  ' Normally I would put all the variables as the top but I want to discuss each
  ' block's variables separately.

  ' This block builds in array "ListName()" a list of all the names.  The list
  ' is in the order in which names are found.  If you have a mispelt name (for
  ' example: "Lsit1") you will get a column for "Lsit1".  You may have to run
  ' the routine, correct any mispelt names and then rerun.

  ' This is not top quality code.  I have had to compromise between good
  ' and easy to understand.  I hope I have the balance right.

  Dim Found As Boolean
  Dim InxNameCrnt As Integer
  Dim InxNameCrntMax As Integer
  Dim NameList() As String
  Dim NameCrnt As String

  ' Using constants makes the code a little easier to understand.
  ' I use the same constants for both the old and new sheets because
  ' the important columns are in the same sequence.
  Const ColFirstList As Integer = 4

  ReDim NameList(1 To 100)      ' Bigger than could be necessary
  InxNameCrntMax = 0

  For RowCrnt = 2 To RowMax
    For ColOldCrnt = ColFirstList To ColOldMax
      ' Get a name out of the array and trim any leading
      ' or trailing spaces
      NameCrnt = Trim(SheetOld(RowCrnt, ColOldCrnt))
      If NameCrnt <> "" Then
        Found = False
        ' Search the current list for this name
        For InxNameCrnt = 1 To InxNameCrntMax
          If NameList(InxNameCrnt) = NameCrnt Then
            ' This name already recorded
            Found = True
            Exit For      ' Exit search
          End If
        Next
        If Not Found Then
          ' Add this name to the end of the list
          InxNameCrntMax = InxNameCrntMax + 1
          NameList(InxNameCrntMax) = NameCrnt
        End If
      End If
    Next
  Next

 Debug.Print "Names in order found:"
 For InxNameCrnt = 1 To InxNameCrntMax
   Debug.Print "|" & NameList(InxNameCrnt);
 Next
 Debug.Print "|"

 Debug.Assert False     ' This stops the routine until you press continue (F5)

 ' The next block builds the output worksheet in array SheetNew().

  ' I have used "Given" and "Family" instead of "Name" and "Surname" so I
  ' can reserve "Name" for the list names.
  Const ColGiven As Integer = 1
  Const ColFamily As Integer = 2
  Const ColEmail As Integer = 3

  Dim ColNewCrnt As Integer
  Dim ColNewMax As Integer
  Dim SheetNew() As String

  ' One column for the columns to the left of the first name and then
  ' one per name.
  ReDim SheetNew(1 To RowMax, 1 To ColFirstList - 1 + InxNameCrntMax)

  ' Copy across columns heading for the first columns
  For ColNewCrnt = 1 To ColFirstList - 1
    SheetNew(1, ColNewCrnt) = SheetOld(1, ColNewCrnt)
  Next
  ' Head the remaining columns with name
  For InxNameCrnt = 1 To InxNameCrntMax
    SheetNew(1, ColFirstList - 1 + InxNameCrnt) = NameList(InxNameCrnt)
  Next

  Debug.Print "First row from new sheet:"
  For RowCrnt = 1 To 1
    For ColNewCrnt = 1 To UBound(SheetNew, 2)
      Debug.Print "|" & SheetNew(RowCrnt, ColNewCrnt);
    Next
    Debug.Print "|"
  Next

 Debug.Assert False     ' This stops the routine until you press continue (F5)

 ' This block copies information from the old sheet to the new sheet

  For RowCrnt = 2 To RowMax
    ' Copy the initial columns unchanged
    For ColNewCrnt = 1 To ColFirstList - 1
      SheetNew(RowCrnt, ColNewCrnt) = SheetOld(RowCrnt, ColNewCrnt)
    Next
    For ColOldCrnt = ColFirstList To ColOldMax
      ' Get a name out of the old sheet and trim any leading
      ' or trailing spaces
      NameCrnt = Trim(SheetOld(RowCrnt, ColOldCrnt))
      If NameCrnt <> "" Then
        Found = False
        ' Search the current list for this name
        For InxNameCrnt = 1 To InxNameCrntMax
          If NameList(InxNameCrnt) = NameCrnt Then
            ' Name found
            Found = True
            Exit For      ' Exit search
          End If
        Next
        Debug.Assert Found  ' Name found on first pass but not second
                            ' Program error
        SheetNew(RowCrnt, ColFirstList - 1 + InxNameCrnt) = "Yes"
      End If
    Next
  Next

  Debug.Print "First 15 rows from new sheet:"
  For RowCrnt = 1 To 15
    For ColNewCrnt = 1 To UBound(SheetNew, 2)
      Debug.Print "|" & SheetNew(RowCrnt, ColNewCrnt);
    Next
    Debug.Print "|"
  Next

 Debug.Assert False     ' This stops the routine until you press continue (F5)

 ' This code assumes the destination sheet is "Sheet2". Change the
 ' "With Sheets()" command if necessary

 With Sheets("Sheet2")
   .Cells.EntireRow.Delete      ' Remove everything for the sheet
   .Rows(1).Font.Bold = True     ' Set the top row to bold
   'Load the worksheet from the array
   .Range(.Cells(1, 1), .Cells(RowMax, UBound(SheetNew, 2))).Value = SheetNew

 End With

 ' I have not bothered about column widths and the columns are in the
 ' sequence found.  You could add a dummy row at the top of the old sheet
 ' for John Doe who gets every list in the sequence you require.  Alternately
 ' you could sort the rows by hand.


End Sub

我希望这一切都有意义。如果你使用这种方法，祝你好运。

相关内容