Фильтрация строк в Excel по данным слова, даты и идентификационного номера


У меня есть 3 столбца идентификатора, поля, и дата (извиняюсь, но я не знаю как формат, так все аккуратно в 3 колонки):

id  field   date
1     a      1
1     b      1
1     d      1
1     a      2
1     s      2
1     d      2
2     a      3
2     d      3
2     b      4
2     s      4
1     w      1
1     q      1
1     b      2

У меня тоже 2 именованные диапазоны, ЖВ:

a
d

и ХХ:

b
s

Именованные диапазоны возможных значений столбца поля.

WW-это список значений, я хочу сохранить и XX-это список значений, которые должны быть удалены, если и только если соответствующее значение существует в WW на один и тот же идентификатор и в тот же день.

То есть, для первой записи, значения 'A' и 'B' по сравнению с id=1 и дата=1. Если оба присутствуют, то я хочу удалить в (из XX именованный диапазон).

id  field   date
1     a     1
1     b     1

становится:

id  field   date
1     a     1

Конечный результат от первоначального набора данных будет:

id  field   date
1     a      1
1     d      1
1     a      2
1     d      2
2     a      3
2     d      3
2     b      4
2     s      4
1     w      1
1     q      1

Использование кода:

И это, как я делаю это:

  • фильтр на основе I-го слова, чтобы сохранить и удалить комбо

  • фильтр на основе идентификационного номера

  • определить соответствующие даты, и фильтр по каждой из соответствующих дат

  • проверьте значения полей и определить их подряд

  • удалить строку, если оба присутствуют

  • повторить фильтр, чтобы проверить другие дни

  • повторить фильтр, чтобы проверить другие идентификаторы

  • повторить фильтр, чтобы проверить другие комбо слово

Обратите внимание, что у меня есть 600к строк, 200 разных значений из поля и диапазон дат охватывает 5-летний период. Мой макрос делает все это, хотя это занимает ~15 часов работы. Вот макрос, который работает:

Sub Manp()
Dim w1 As Range
Dim w2 As Range
Set w1 = Range("ww") 'named range of words to keep
Set w2 = Range("xx") 'named range of words to remove
O = Cells(Rows.Count, 1).End(xlUp).Row 'count number of records for specific id#
Application.ScreenUpdating = False

For i = 1 To w1.Rows.Count 'subset based on common fields, one to keep, one to remove
    Application.StatusBar = i
    v = Range(w1(i), w2(i))
    For Each j In [pp]
        Sheets("Sheet1").Select
        Selection.AutoFilter Field:=2, Criteria1:=v, Operator:=xlFilterValues 'filter by key fields
        Sheets("Sheet1").Range("$A$1:$C$15").AutoFilter Field:=1, Criteria1:=j ' filter by id#
        N3 = Cells(Rows.Count, 1).End(xlUp).Row
        If N3 > 1 Then
            Range("C2:C" & O).Copy Destination:=Sheets("Sheet4").Range("J1")
            Sheets("Sheet4").Select
            Columns(10).RemoveDuplicates Columns:=Array(1)
            N2 = Cells(Rows.Count, 10).End(xlUp).Row
            If N2 = 1 Then
                ddd = Range("J1:J" & N2 + 1).Value
                Else
                ddd = Range("J1:J" & N2).Value ' have unique list of days
            End If
            Columns(10).Clear
            Sheets("Sheet1").Select
             For Each k In ddd ' filter on each day
                Sheets("Sheet1").Select
                If Sheets("sheet1").AutoFilterMode Then Sheets("sheet1").ShowAllData
                Selection.AutoFilter Field:=2, Criteria1:=v, Operator:=xlFilterValues 'filter by key fields
                Sheets("Sheet1").Range("$A$1:$C$15").AutoFilter Field:=1, Criteria1:=j ' filter by id#
                Sheets("Sheet1").Range("$A$1:$C$15").AutoFilter Field:=3, Criteria1:=k
                 'check contents of cells
                Set visRng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible) ' Select only rows within the used range that are visible.
                Dim r As Range
                 Rowz = Sheets("Sheet1").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
                    If Rowz > 1 Then
                        r1 = 0
                        r2 = 0
                        For Each r In visRng.Rows ' Loop through each row in our visible range ...
                            If Cells(r.Row, 2) = w1(i) Then r1 = r.Row ' check if cell value is a keeper
                            If Cells(r.Row, 2) = w2(i) Then r2 = r.Row ' check if cell value is a discard wrt a keeper
                            If r1 > 0 And r2 > 0 Then Rows(r2).Delete ' check if both keeper and discard are in same subset
                        Next
                    End If
                Next k
            End If



        If Sheets("sheet1").AutoFilterMode Then Sheets("sheet1").ShowAllData
    Next j


Next i
Application.ScreenUpdating = True
End Sub

Я бы с удовольствием любые предложения, чтобы улучшить производительность этот макрос!



585
2
задан 22 февраля 2018 в 02:02 Источник Поделиться
Комментарии
3 ответа

Всякий раз, когда вы смотрите на время обработки этот длинный, это нужно для работы с массивами.

Когда вы не совпадающими значениями в большом списке использовать коллекции (например, на VBA.Коллекция, Сценариев.Словарь, Система.Коллекции.Коллекции ...). В данном случае я бы использовать ArrayList, потому что нас интересуют только уникальные значения, а не пары ключ/значение.

Хороший именования переменных является залогом хорошего кодирования.

Sheets("Sheet1").Range("$A$1:$C$15").AutoFilter работает? Я предполагаю, что VBA-Это автоматическое изменение диапазона фильтра. Я также обеспечить правильный диапазон. Кто знал.

.SpecialCells без обработчиков ошибок. Что может привести к неприятностям.

Вот как использовать .SpecialCells:

On Error Resume Next
Set visRng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not visRng Is Nothing Then

Рекомендуется, чтобы все ряды были полными. Вы должны избегать Selecting или Activating объекты, если только это действительно необходимо( смотреть: VBA для Excel введение Часть 5 - Выбор ячейки (диапазона ячеек, и activecell, конец, смещение)).

Вот шаги, чтобы быстро удалить данные из большого диапазона


  • Определить целевой диапазон

  • Загрузите целевой диапазон значений в массив

  • Создать 2-й массив такого же размера, как 1-й массив

  • Загрузить все данные, которые вы хотите сохранить на 2-й массив

  • Запись 2-го значения массива по целевым значениям

Эту технику следует уменьшить время работы с 15 часов до 25-45 секунд.

Я привожу ниже код в качестве демонстрации. Это не означало бы полного решения. Я, возможно, пропустили некоторые детали в спецификации ОП.

Sub RemoveValues()
Dim listKeep As Object, listNoDups As Object, list As Object, key As Variant, Target As Range
Dim data As Variant, results As Variant
Dim r As Long, r2 As Long
Dim flag As Boolean

Set dicKeep = getRangeList("ww")
Set dicNoDups = getRangeList("xx")

Set list = CreateObject("System.Collections.ArrayList")

With Worksheets("Sheet1")
Set Target = .Range("A1", .Range("C" & .Rows.count).End(xlUp))
End With

data = Target.Value

ReDim results(1 To UBound(data), 1 To UBound(data, 2))

For r = 1 To UBound(data)
key = data(r, 1) & "|" & data(r, 2) & "|" & data(r, 3)
flag = False

If Not list.Contains(data(r, 2)) Then
flag = True
ElseIf dicKeep.Contains(data(r, 2)) Then
flag = True
ElseIf Not dicNoDups.Contains(data(r, 2)) Then
'Does this even matter???
End If

If flag Then
r2 = r2 + 1
results(r2, 1) = data(r, 1)
results(r2, 2) = data(r, 2)
results(r2, 3) = data(r, 3)
End If

If Not list.Contains(key) Then list.Add key
Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Target.Value = results

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Function getRangeList(RangeName As String) As Object
Dim list As Object, key As Variant
Set list = CreateObject("System.Collections.ArrayList")

For Each key In Range(RangeName).Value
list.Add key
Next

Set getRangeList = list
End Function

2
ответ дан 22 февраля 2018 в 08:02 Источник Поделиться

Я не знаю, если ваш отступ был удален, когда вы вставили код, но вы всегда хотите, чтобы ваш код с отступом, начиная после Sub. Это хорошая практика для отступа кода этак Labels будет торчать как очевидное.


Явный Параметр

Всегда включаю Option Explicit. Вы можете иметь его автоматически, зайдя в Инструменты -> Параметры в программу и проверки требуют переменной вариант. Таким образом, если у вас есть какие-либо переменные не определен, компилятор даст вам знать.

Если я делаю Option Explicit в верхней части, у вас есть тонна необъявленных переменных

Dim O
Dim i
Dim v
Dim j
Dim N3
Dim N2
Dim ddd
Dim k
Dim visRng
Dim rowz
Dim r1
Dim r2

Когда вы не определяете переменную, ВБА объявим его как вариант, которые являются объектами:


Производительности. Переменная, объявленная с типом объекта является достаточно гибкой, чтобы содержать ссылку на любой объект. Однако, когда вы вызываете
метод или свойство на такую переменную, вы всегда нести позднего связывания
(во время выполнения). В силу раннее связывание (во время компиляции) и лучше
производительность, объявить переменную с определенным именем класса, или литой
ее к определенному типу данных.

Не объявляя переменные, вы могли бы быть платить штраф.

Когда вы не определяете переменную, ВБА объявим его как вариант тип, который может хранить любой тип данных. Хотя это может быть более гибкими, это увеличивает время обработки в макрос, как VBA решает или тесты для типа. Кроме того, так как вариант может быть любой тип данных, вы можете упустить ценные сведения об устранении неполадок на несоответствие типов


Именования Переменных

Говоря о переменных, - давать переменным осмысленные имена. Персонажи бесплатным и может только помочь уточнить код. visRng может быть улучшено только путем переименования его visibleRange и ничего не стоит.

Все эти переменные можно не объявлять, что они могли быть? Имена дать вам понятия не имею, что они могли бы быть, или даже то, что типу они должны быть. Когда вы в конечном итоге с переменными, которые пронумерованы, вы знаете имена могут быть улучшены. например

i - targetRow
v - targetRange
N3 - lastRow
ddd - uniqueDays

и т. д.. посмотрим, прежде чем я предполагаю ddd был целый ряд, но это не так, это массив, из-за неявного типа из ddd быть вариант. Нейминг-это огромная часть делает ваш код более ясным, даже когда очевидно, что вы делаете в данный момент, в 6 месяцев или год, когда вы вернетесь, вам придется идти построчно, чтобы понять, что вы делаете. Объявить эти переменные и давать им хорошие имена!

Кроме того, что делает Manp в смысле? Скажи мне, что ваша процедура делает во имя.


Комментарии

Комментарии - "код сказать вам, как, комментарии, скажу вам, почему". Код должен говорить сам за себя, если он нуждается в комментариях, его нужно сделать более четким. Если нет, то комментарий должен описывать , почему вы делаете что-то, а не как ты делаешь это. Вот несколько причин , чтобы избежать замечаний все вместе.


O = Cells(Rows.Count, 1).End(xlUp).row 'count number of records for specific id#

Почему не просто

countOfRecords = Cells(Rows.Count,1).End(xlUp).row

Видим, что переменные имя полностью удалить комментарий. Ура.


Неявный Отбор

Вежливость Rubberduck-ВБА
enter image description here

Когда вы не можете претендовать, где диапазон, он будет неявно предполагаешь, что это activesheet. Так


 Set w1 = Range("ww")

Всегда будет активный лист. Скажи мне, где ассортимент. На самом деле

Dim targetSheet As Worksheet
Dim wordsToKeepRange As Range
Dim wordsToRemoveRange As Range
Set wordsToKeepRange = targetSheet.Range("ww")
Set wordsToRemoveRange = targetSheet.Range("xx")

Что прекрасно работает. Но эти именованные диапазоны, что это за имена такие? Кроме того, листы имеют CodeName свойства - просмотр свойств окна (Ф4) и (Name) поля (в верхней части) может быть использован как имя листа. Таким образом, вы можете избежать Sheets("mySheet") и вместо того, чтобы просто использовать mySheet.

Работая в лист

Будьте уверены, чтобы избежать вещи, как .Select - он просто замедляет код по необходимости возиться с электронными таблицами, а делать все остальное за кадром. Есть хороший вопрос на StackOverflow решение этой.


Обратите внимание, что у меня есть 600к строк, 200 различных значений поля, и
диапазон дат охватывает 5-летний период. Мой макрос делает все это, хотя
занимает ~15 часов работы.

Упс. Просто переместить данные в массив, вероятно, снизится, что времени на значительную сумму.

Dim lastRow As Long
lastRow = targetSheet.Cells(Rows.Count, 1).End(xlUp).row
Dim lastColumn As Long
lastColumn = targetSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Dim myData As Variant
myData = targetSheet.Range(Cells(1, 1), Cells(lastRow, lastColumn))

Теперь вы можете сделать все в myData.


Application.StatusBar = i

Может быть, это для отладки, но это будет замедлять вас вниз, каждый ряд. И вот с Application.ScreenUpdating = False?

Без переписывания кода, просто глядя на ваше описание, вы могли бы начать с чего-то вроде

Const TARGET_DUPLICATES_COLUMN As Long = 621
Dim lastRow As Long
lastRow = targetSheet.Cells(Rows.Count, 1).End(xlUp).row
Dim lastColumn As Long
lastColumn = targetSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Dim rawData As Variant
rawData = targetSheet.Range(Cells(1, 1), Cells(lastRow, lastColumn))
Dim noDuplicateData As Variant
Dim arrayIndex As Long
For arrayIndex = LBound(rawData) To UBound(rawData)
'look for duplicates and move them to new array
Next


В реальности я бы, наверное, использовать Scripting.Dictionary как это довольно легко, чтобы избежать дубликатов при добавлении членов словаре со значением = 1, они не могут повторить. Затем использовать его в качестве справочник по очистке рядов. Я бы тоже, наверное, потянет в какой-то сортировки в массив, чтобы я мог организовать это по каким полям мне нужно, этак будто я перебирать все, что я должен быть в состоянии соответствовать дубликаты, как я иду и просто не скопировать их в новый массив.

0
ответ дан 22 февраля 2018 в 10:02 Источник Поделиться

У меня нет много, чтобы добавить к существующему ответы, что все довольно хороших способов решить эту задачу. Но я решил упомянуть, что такую проблему гораздо легче решить, когда ваши данные находятся в базе данных. С 600к строк, ты подходишь к границам того, что возможно (или по крайней мере желательно) сделать в Excel. Я все для творческих решений VBA, но я предпочитаю, чтобы встраивать SQL в таких случаях (т. е. хранить данные в базе данных, запустите SQL-запроса/заполнить книгу из объект adodb соединение через VBA).

Если исходить из ваших основных данных в одной таблице, а ваши "войны" и "ХХ" диапазоны были две колонки под названием "китайцы" и "удалить" в другую таблицу в SQL решение будет довольно простым:

SELECT
d.id 'ID',
d.dtdate 'Date',
d.fld 'Field'
FROM
maindata d
LEFT JOIN
(
SELECT
d1.id 'ID',
d1.dtdate 'Date',
d1.fld 'Field'
FROM
maindata d1
INNER JOIN
keepremove kr ON
(d1.fld = kr.toremove)
INNER JOIN
maindata d2 ON
(d2.fld = d1.fld) AND
(d2.dtdate = d1.dtdate) AND
(d2.fld = kr.tokeep)
GROUP BY
d1.id,
d1.dtdate,
d1.fld
) sq ON
(sq.id = d.id) AND
(sq.date = d.dtdate) AND
(sq.field = d.fld)
WHERE
sq.id IS NULL

0
ответ дан 28 февраля 2018 в 09:02 Источник Поделиться