Подход через фильтрацию массива
Вам нужно фильтровать результаты по строкам (например, Тесси Пол - 26 апреля 18, 27 апреля 18, 30 апреля 18, 2 мая 18), но IMO вы не получите их с помощью расширенного фильтра метод , Вместо этого я демонстрирую альтернативный подход, использующий массивы для получения исходных данных (медленный цикл по диапазону через VBA) и извлечения переставленных (= перекодированных) данных через Application.Filter соответствующих элементов, помеченных "x" как обязанность .
Основные шаги
Сначала вы записываете все свои данные в вариант 2-мерного массива полей данных, просто назначая предопределенную ссылку на диапазон - см. Раздел [2]:
Dim v As Variant ' or simply: Dim v
Dim rng As Range
'set rng = ...
v = rng.Value2 ' or simply: v = rng
Кроме того, можно фильтровать массив через Application.Filter с некоторыми ограничениями:
- a) вам потребуется дополнительная информация помимо данных об изолированных ячейках и
б) вам понадобится 1-мерный массив.
ad a) Чтобы определить имя и дату обязанности при фильтрации, просто добавьте эту информацию вместе с разделителем (например, "#", см. Раздел [3]).
Это позволяет позже разделить отфильтрованные данные, просматривая каждый элемент массива - см. Разделы [4] и [5].
ad b) Чтобы получить массив с 1 дим из массива с 2 димами, вы можете извлечь строку или столбец с помощью функции Application.Index.
В приведенном ниже примере я присваиваю результаты другому массиву с именем vi.
Например: если вы хотите извлечь строку, как показано в разделе 4.1, второй параметр идентифицирует номер строки, начиная с 1, третий аргумент номер столбца просто получает 0:
Затем вы можете применить функцию Filter с этим новым исходным массивом и строкой соответствия "x #", чтобы получить все данные, определенные как Duty с помощью символа x и выбранного разделителя # .
vi = VBA.filter (Application.Index (v, i, 0), "x #", True, False)
Примечания:
Строка соответствия состоит из обоих символов ("x #"), так как только "x" также может быть частью имени (например, Alexander).
В качестве дополнения к строчной фильтрации:
Чтобы извлечь столбец, см. Раздел 5.1, так как для этого требуется дополнительная настройка с помощью Application.Transpose.
Каждый извлеченный массив строк или столбцов будет записан обратно на целевой лист и показан с помощью функции Join в Debug.Print в вашем непосредственном окне в редакторе Visual Basic (VBE)
Пример кода
Option Explicit
Sub DutiesPerName()
' Site: /10132497/kak-ispolzovat-rasshirennuy-filtratsiy-strok
' [0] Declare variables
Dim a()
Dim ws As Worksheet, ws2 As Worksheet
Dim rng As Range, i As Long, j As Long, r As Long, c As Long
Dim v, vi, temp
' [1] define sheetname and data range
' 1.0 set worksheet object to memory
Set ws = ThisWorkbook.Worksheets("MyDataSheet") ' << change to your data sheet name
Set ws2 = ThisWorkbook.Worksheets("MyDutySheet") ' << change to your target sheet name
' 1.1 get rows and columns
r = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
c = ws.Range("A1").End(xlToRight).Column
' 1.2 Alternative code line: Set rng = ws.UsedRange
Set rng = ws.Range(ws.Range(ws.Cells(1, 1), ws.Cells(r, c)).Address)
' [2] create a variant 1-based 2-dim datafield array
v = rng.Value2
' [3] CODE duty items by appending "#" plus date and name info
For i = 2 To UBound(v) ' start loop from 2nd row
v(i, 1) = "x#" & v(i, 1) ' mark name captions to get them filtered, too
For j = 3 To UBound(v, 2) ' start inner loop from 3rd column
If v(i, j) = "x" Then ' code found duty items
v(i, j) = v(i, j) & "#" & Format(v(1, j), "dd-mmm-yy") & "#" & v(i, 1) & "#" & j
'Debug.Print "v(" & i & "," & j & ")=""" & v(i, j) & """"
End If
Next j
Next i
' mark date captions with "x#" to get them filterd, too
For j = 3 To UBound(v, 2)
v(1, j) = "x###" & Format(Val(v(1, j)), "dd-mmm-yy")
Next j
' -----------------------
' [4] Duty Dates per Name:
' -----------------------
ws2.Cells.Clear: ws2.Range("A1") = "Name": ws2.Range("B1") = "Duty Dates ..."
For i = 2 To UBound(v, 1) ' start loop from 2nd row
' 4.1 filter redimensioned 1-dim ROW array via "x#"
vi = VBA.filter(Application.Index(v, i, 0), "x#", True, False)
For j = LBound(vi) To UBound(vi)
vi(j) = Split(vi(j), "#")(1) ' extracts date from e.g. "x#15-Jan-19#x#Paul#2"
Next j
' write dates per name into target worksheet ws2
ws2.Range("A1").Offset(i - 1, 0).Resize(1, UBound(vi) + 1) = vi
Debug.Print "Row# " & i & " (" & _
ws2.Range("A1").Offset(i - 1, 0).Resize(1, UBound(vi) + 1).Address & ") 1 Name + " & UBound(vi) & " Dates: " & _
Join(vi, ", ")
Next i
Debug.Print
' -----------------------
' [5] Names per Duty Date:
' -----------------------
ws2.Range("A1").Offset(r + 2, 0) = "Duty Date": ws2.Range("A1").Offset(r + 2, 1) = "Names ..."
For i = 3 To UBound(v, 2) ' start loop from 3rd column
' 5.1 filter redimensioned 1-dim COLUMN array via "x#"
vi = VBA.filter(Application.Transpose(Application.Index(v, 0, i)), "x#", True, False)
For j = LBound(vi) To UBound(vi)
temp = Split(vi(j), "#")
vi(j) = temp(3) ' extracts Name from e.g. "x#15-Jan-19#x#Albert#3"
Next j
' write each names per date into target worksheet ws2
If UBound(vi) > -1 Then
ws2.Range("A1").Offset(r + i, 0).Resize(1, UBound(vi) + 1) = vi
Debug.Print "Col# " & i & " (" & _
ws2.Range("A1").Offset(r + i, 0).Resize(1, UBound(vi) + 1).Address & ") 1 Date + " & UBound(vi) & " Names: " & _
Join(vi, ", ")
End If
Next i
End Sub