Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Удаление повторяющихся столбцов (по значению в ячейках одной строки) - какой способ быстрее?
 
Добрый день, как лучше всего искать повторяющиеся значения в ячейках одной строки? Количество ячеек в строке меняется. Искал методы, понял что быстрее всего будет работать словарь. Но не совсем понимаю как это реализовать.
 
Neyrovision,  Поиск повторов - что  в вашем понимании означает? Что на входе, что на выходе?
 
... и это - в файле-примере.
 
А СЧЁТЕСЛИ не рассматриваете?
 
Быстрее всего будет работать коллекция. Ну уж по сравнению с словарём точно быстрее. Только это совершенно не важно если рассматриваем строку, будь она хоть на все 16к штук заполнена :)
 
БМВ, например в первой строке с A1 по CL1 в каждой ячейке есть слова "Яблоки"; "Груши"; "Бананы"; "Яблоки"; "Сливы"; и тд
Нужно убрать все повторения, в данном случае Яблоки 2 раза, нужно оставить только одно слово Яблоки, остальные удалить.
Юрий М, нужен скрипт
Hugo, Если так, то буду рад примеру.
Забыл сказать что если в какой-то колонке находится повторяющееся значение, нужно удалить всю эту колонку.
 
У меня в голове есть примерный алгоритм
В цикле заносить по одной ячейке в словарь, и так как в нем не могут повторяться ключи, то при добавлении повторяющегося слова он даст об этом знать, следовательно удалить этот столбец. Но как это реализовать не особо понимаю. Как сделать так чтобы скрипт среагировал на это...
 
Цитата
Hugo написал:
Быстрее всего будет работать коллекция.
Универсальнее - однозначно, я про огрызочный Excel, быстрее - ну окажется что надо обработать 100 столбцов (ячеек) :-) .сперва написал и только потом СL1 увидел,  поправочка 90 :-), при этом основное время уйдет на удаление столбцов если UNION не прокатит.

Цитата
Neyrovision написал:
Забыл сказать что если в какой-то колонке находится повторяющееся значение, нужно удалить всю эту колонку.
Вот э то и есть вопрос темы, а не "Поиск повторов через dictionary"
Изменено: БМВ - 2 Сен 2018 20:44:10
 
Цитата
Neyrovision написал:
...удалить этот столбец
Какой из столбцов удалять, если их несколько таких?
Даже не так: какой оставить )
 
БМВ, ну если ~5000 столбцов это не много, то рассмотрю и другие методы
Цитата
БМВ написал:
основное время уйдет на удаление столбцов если UNION не прокатит
А что Columns(A).Delete будет медленно работать?
 
Да и с названием темы действительно беда: ничего, кроме словаря предлагать нельзя - сами так поставили вопрос.
 
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=98608
 
Цитата
БМВ написал:
основное время уйдет на удаление столбцов если UNION не прокатит.
Здравствуйте, коллеги! Думаю, что самым быстрым будет удаление столбцов методом, аналогичным методу удаления строк от Владимира (ZVI).
Владимир
 
Юрий М, Да, осечка с названием, думал он будет оптимален, оказалось не так
 
sokol92,  Владимир, если вы о пометить отсортировать удалить, вернуть порядок, то в случае со столбцами и ограничением в 16000 возможно это и не требуется.
 
Neyrovision, название поменял. В следующий раз формулируйте более конкретно.
Насколько критично время, если учесть, что столбцов не так уж и много - всего 16384? И ведь не все они у Вас будут задействованы?
Может устроит обычная работа с ячейками?
Код
Sub Macroq()
Dim LastColumn As Long, i As Long
    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    Application.ScreenUpdating = False
    For i = LastColumn To 2 Step -1
        If Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(1, i)), Cells(1, i)) > 1 Then Columns(i).Delete
    Next
    Application.ScreenUpdating = True
End Sub
Не устроит - по крайней мере будет вариант, с чем сравнивать скорость )
 
Цитата
Neyrovision написал:
рассмотрю и другие методы
Вероятно, быстрее всего будет ввести в доп. строку формулу
Код
=СЧЁТЕСЛИ($A1:A1;A1)
, отсортировать по этой строке СТОЛБЦЫ по возрастанию, удалить столбцы начиная с того, где значение в этой строке будет 2.
Непрерывный диапазон строк или столбцов удаляется гораздо быстрее, чем по одной строке или столбцу.
 
Цитата
БМВ написал:
пометить отсортировать удалить, вернуть порядок
Возвращать порядок излишне ввиду (приятной) особенности сортировки Excel: внутри одного множества ключей сортировки сохраняется первоначальный порядок строк (столбцов). Об этом же пишет и Алексей в #17.
Изменено: sokol92 - 2 Сен 2018 22:39:06
Владимир
 
Если кто хочет предложить варианты удаления, то давайте для сравнения делать это на одних и тех же данных?
Я прогонял свой вариант на 10010 ячейках: 385 блоков по 26 ячеек (в ячейках блока заголовки столбцов). удаляются 9984 столбца. По одному. Макросы заполнения и удаления ниже.
На моей машине 9984 столбца удаляются за 2,2...2,3 с.
Код
Sub Addd()
Dim i As Long, j As Long, Rng As Range
    For i = 1 To 26
        Cells(1, i) = Cells(1, i).Address
    Next
    Set Rng = Range(Cells(1, 1), Cells(1, 26))
    For i = 27 To 10000 Step 26
        Rng.Copy Cells(1, i)
    Next
End Sub

Sub Delett()
Dim LastColumn As Long, i As Long, t
    t = Timer
    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    Application.ScreenUpdating = False
    For i = LastColumn To 2 Step -1
        If Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(1, i)), Cells(1, i)) > 1 Then Columns(i).Delete
    Next
    Application.ScreenUpdating = True
    Debug.Print Timer - t
End Sub
 
Здравствуйте, Юрий! Обязательно произведу сравнение (как только появится время).
Владимир
 
Выкладываю результаты сопоставления методов удаления столбцов для таблиц с разным числом строк. Win10, Excel 2016 (32-)
Код
--- Удаление столбцов по одному
Строк 1       ячеек 26      время 2,3
Строк 50      ячеек 1300    время 3,1
Строк 100     ячеек 2600    время 3,9
Строк 200     ячеек 5200    время 6,3
Строк 500     ячеек 13000   время 15,2
--- Удаление столбцов сортировкой
Строк 1       ячеек 26      время 0,0
Строк 50      ячеек 1300    время 0,1
Строк 100     ячеек 2600    время 0,3
Строк 200     ячеек 5200    время 0,5
Строк 500     ячеек 13000   время 1,1
На "старой" конфигурации Excel 2007 результаты более драматичны (500 строк не сравнивалось):
Код
--- Удаление столбцов по одному
Строк 1       ячеек 26      время 4,8
Строк 50      ячеек 1300    время 96,7
Строк 100     ячеек 2600    время 187,3
Строк 200     ячеек 5200    время 372,0
--- Удаление столбцов сортировкой
Строк 1       ячеек 26      время 0,0
Строк 50      ячеек 1300    время 0,1
Строк 100     ячеек 2600    время 0,2
Строк 200     ячеек 5200    время 0,4

Текст макросов:

Код
Option Explicit
Dim t As Double
Sub test()
    Dim arr, v, i As Long
    Application.ScreenUpdating = False
    arr = Array(1, 50, 100, 200, 500)                      ' число строк таблицы
    For i = 1 To 2
        Debug.Print "--- Удаление столбцов " & Choose(i, "по одному", "сортировкой")
        For Each v In arr
            Addd v, 1
            DoEvents
            t = Timer
            If i = 1 Then
                Delett
            Else
                Delete2
            End If
            Fin
            DoEvents
        Next v
    Next i
    Application.ScreenUpdating = True
End Sub

Sub Addd(ByVal nRows As Long, method As Long)
    Dim i As Long, rng As Range
    Workbooks.Add
    If method = 1 Then
        For i = 1 To 26
            Cells(1, i) = Cells(1, i).Address
        Next
        Set rng = Range(Cells(1, 1), Cells(1, 26))
        For i = 27 To 10000 Step 26
            rng.Copy Cells(1, i)
        Next
    Else                                              ' заполнение первой строки случайными числами
        Rnd -0.5                                      ' для повторяемости
        For i = 1 To 10100
            Cells(1, i) = "A" & Int(Rnd * 100)
        Next
    End If

    If nRows > 1 Then
        With Range(Cells(2, 1), Cells(nRows, 10010))
            .Formula = "=Row(A2) + Column(A2)"
            .Value = .Value
        End With
    End If
End Sub

Sub Delett()
    Dim LastColumn As Long, i As Long, t
    t = Timer
    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    For i = LastColumn To 2 Step -1
        If Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(1, i)), Cells(1, i)) > 1 Then Columns(i).Delete
    Next
End Sub

Sub Fin()
    With Range("A1").CurrentRegion
        Debug.Print "Строк " & .Rows.Count, "ячеек " & .Cells.Count, "время " & FormatNumber(Timer - t, 1)
    End With

    With ActiveWorkbook
        .Saved = True: .Close
    End With
End Sub

Sub Delete2()
    Dim rng As Range, rng1, dic As Object, arr1, arr2, nRows As Long, nCols As Long, nCols2, i As Long, v
    Set rng = Range("A1").CurrentRegion
    Set rng = rng.Resize(rng.Rows.Count + 1)
    nRows = rng.Rows.Count
    nCols = rng.Columns.Count
    Set dic = CreateObject("Scripting.Dictionary")
    arr1 = rng.Rows(1).Value
    For i = 1 To nCols
        v = arr1(1, i)
        If dic.exists(v) Then
            arr1(1, i) = 1
        Else
            dic(v) = 1
            arr1(1, i) = 0
            nCols2 = nCols2 + 1
        End If
    Next i
    rng.Rows(nRows).Value = arr1

    If nCols2 < nCols Then
        With rng
            .Sort .Rows(nRows), Orientation:=xlSortColumns
            .Offset(, nCols2).Resize(nCols - nCols2).EntireColumn.Delete
        End With
    End If
    rng.Rows(nRows).ClearContents
End Sub

 
Владимир
 
sokol92, Владимир, тест не совсем полный , так как не т варианта с UNION, без сортировки.
 
Здравствуйте, Михаил! Метод с Union займет почетное второе место в случае заполнения первой строки в соответствии с #19, поскольку там удаляются все столбцы с номерами 27-10100, а Union "соображает", как объединять смежные диапазоны. Если же заполнить первую строку так:
Код
For i = 1 To 10100
   Cells(1, i) = IIf(i Mod 2 = 0, 1, i)
Next i

то метод с Union уйдет в очень глубокие размышления. Скорость метода удаления через сортировку не поменяется.
Владимир
 
Тутати спидами мерялись.
Правда удаляли не столбцы, а строки, но, думаю, погоды не делает.
Страницы: 1
Читают тему (гостей: 1)
Наверх