Вопрос: Фильтрация и переупорядочение столбцов в Excel


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

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

Source Table

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

Destiny Table

Или что-то подобное (вместо «Да» или «пустое», я мог бы иметь «Да» и «Нет»). Таким образом, я мог бы фильтровать таблицу по списку, что невозможно в моей текущей таблице: столбцы в исходной таблице, как вы можете видеть, могут содержать разные списки в каждой строке. Возможно ли это в 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 !!


1
2017-11-26 11:31


Источник


Вы делаете это на месте или перемещаете каждую строку на новый лист в порядке? Я не уверен, как это возможно с помощью формул, но можете ли вы использовать VBA? - jonsca
Может быть создан новый лист, и решение может использовать VBA, конечно, хотя я точно не знаю, как он будет применяться. Если есть код VBA, можете ли вы дать некоторые сведения о запуске кода (требования, шаги), чтобы получить желаемый результат? - javipas
Являются ли списки действительно называемыми «List1», или они называются чем-то другим. Если это так, вы можете принять эти значения, отбросить «Список» и использовать их в качестве индексов для значений «да» в массиве, а затем просто написать весь бизнес снова. - jonsca
(если они не называются подобными, это всего лишь вопрос об обнаружении уникальных значений и т. д.), - jonsca
@jonsca, списки не называются подобными, но у них есть уникальные имена, но я не понимаю ваш подход. Можете ли вы быть более конкретным? - javipas


Ответы:


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

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

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


1
2017-11-26 19:29



W_Whalley, это кажется многообещающим способом сделать то, что я хочу. Ваша формула не работает, но я пытаюсь настроить ее, чтобы она работала по своему усмотрению. Как только я получу его, я обновлю свой вопрос, спасибо! - javipas
Похоже, для функции поиска по запросу Excel может потребоваться позиция для начала поиска, то есть SEARCH (L $ 1, $ D2 & $ E2 & $ F2 & $ G2 & $ H2 & $ I2 & $ J2 & $ K2,1). Начальная позиция является необязательной в LibreOffice (по умолчанию 1). - W_Whalley


Это решение 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

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


0
2017-11-28 23:34