Фильтр и изменение порядка столбцов в Excel

Question

У меня есть служба (phplist, менеджер рассылки), которая экспортирует список пользователей с несколькими полями. В конце каждого пользователя есть один или несколько списков, на которые он подписан.

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

Я хотел бы, чтобы, если бы у меня было, например, восемь информационных бюллетеней (списков), я мог в Excel преобразовать эту таблицу в таблицу, которая создает надлежащие столбцы и заполняет данные внутри. Результат предыдущей преобразованной таблицы будет следующим:

Или что-то похожее (вместо «Да» или «Пробел» я мог бы иметь «Да» и «Нет», что угодно). Таким образом, я мог бы фильтровать таблицу по списку, что невозможно с моей текущей таблицей: столбцы в исходной таблице, как вы можете видеть, могут содержать разные списки в каждой строке. Возможно ли это в Excel?

Окончательное решение:

Благодаря W_Whalley мне удалось найти реальный ответ на проблему. Если кто-то использовал PHPList, этот менеджер новостных рассылок позволяет вам загружать список подписавшихся пользователей, но, как я уже упоминал в исходном вопросе, он не дает вам списки, на которые он подписан. Фактически, это дает вам окончательный столбец со всеми списками в одной ячейке. Это немного отличается от проблемы, которую я рассмотрел, потому что строка этой таблицы будет:

Name | Surname |     Email    |    Lists

John | Perry | john@mail.com | List1 List3 List6 List 7

И не

Name | Surname |     Email    |    Lists

John | Perry | john@mail.com | 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 !!

Answer 1

Вот решение не VBA. Предполагая, что у вас есть максимум 8 списков (вы можете настроить их по мере необходимости) и что для удобства таблица, с которой вы начинаете, начинается с ячейки A1. Поместите имена строк для списков в ячейках от L1 до S1. Введите эту формулу в ячейку L2 = IF (ISERROR (ПОИСК (L $ 1, $ D2 & $ E2 & $ F2 & $ G2 & $ H2 & $ I2 & $ J2 & $ K2)), "нет", "да") Скопируйте эту формулу из L1 в S2 , затем скопируйте, насколько вам нужно.

Что он делает: SEARCH("listN", [сцепленный "list1 ... list8"]) возвращает начальный порядковый номер соответствующей части строки или, если не найден, ошибку #VALUE (по крайней мере, в LibreOffice. Извините, нет Excel для тестирования). Функция ISERROR возвращает "нет", если есть ошибка, и "да", если нет, то есть, если в именах составного списка найдена строка "listN".

Затем вы можете отфильтровать таблицу с помощью функции автофильтра. Кажется, работает с 60000 строк.

Answer 2

Это решение VBA, если решение на основе формулы не соответствует вашим требованиям.

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

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

Я надеюсь, что все это имеет смысл. Желаем удачи, если вы используете этот подход.