Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.04.2011, 16:18   #21
Hom_1985
 
Регистрация: 03.04.2011
Сообщений: 5
По умолчанию

Цитата:
Сообщение от Hugo121 Посмотреть сообщение
If Err <> 0 Then -> значит не добавилось в коллекцию -> значит повтор -> значит добавляем в диапазон для удаления.

Но на большом количестве удаляемых будут тормоза именно при внесении в Union.
Спасибо. Ловко придумано. Но мне нужно просто удалить одинаковые строки . у нас в фирме просто у всех 2003 excel . в 2007 эта функция уже встроена.
Hom_1985 вне форума Ответить с цитированием
Старый 04.04.2011, 13:09   #22
Hom_1985
 
Регистрация: 03.04.2011
Сообщений: 5
По умолчанию

Цитата:
Сообщение от SAS888 Посмотреть сообщение
Для решения подобных задач, лучше не работать непосредственно с ячейками рабочего листа. Это очень долго. Работа с массивами существенно быстрее. Да и перебирать для сравнения можно не каждую ячейку (элемент массива), а целиком строки.
Для примера, предлагаю макрос для удаления повторяющихся строк в выбранном диапазоне для одного (активного) листа:
Код:
Sub Main()
    Dim x As Range, y As New Collection, i As Long, j As Long, k As Long, a(), b(), s As String
    On Error Resume Next: Set x = Application.InputBox("Выделить", "Диапазон сравнения", Type:=8)
    If Err <> 0 Then Exit Sub
    Set x = Intersect(x, ActiveSheet.UsedRange) 'На случай, если выделены столбцы целиком
    a = x.Value: ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2)): j = 1
    For i = 1 To UBound(a, 1)
        s = Join(Application.Index(a, i, 0), "|")
        On Error Resume Next: y.Add s, s
        If Err = 0 Then
            For k = 1 To UBound(a, 2): b(j, k) = a(i, k): Next: j = j + 1
        Else: On Error GoTo 0
    End If: Next: x.Value = b
End Sub
Цикл по листам (всем или избранным) "прикрутите" самостоятельно. Если что-то не получится - пишите.
Не могли бы Вы подсказать про использование оператора
s = Join(Application.Index(a, i, 0), "|")
Ведь join объеденяет элементы одномерного массива. в связи с этим очень интересна строка Application.Index(a, i, 0). Спасибо
Hom_1985 вне форума Ответить с цитированием
Старый 04.04.2011, 17:58   #23
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Функция Application.Index(a, i, 0) вернет одномерный массив, состоящий из элементов строки i двумерного массива a.
Соответственно, функция Join(Application.Index(a, i, 0), "|") вернет строковую переменную, представляющую собой все элементы полученного одномерного массива, разделенные символом "|".
Таким образом, строковая переменная s = Join(Application.Index(a, i, 0), "|") будет содержать значения всех ячеек строки i в определенном диапазоне, разделенных указанным символом.
Именно эти значения мы и заносим в коллекцию. А как известно, коллекция не может содержать два одинаковых элемента. Таким образом, перехватывая возможную ошибку при добавлении элемента в коллекцию, мы определяем, встречался ли нам такой элемент ранее, или нет.

P.S. На будущее: если требуется получить одномерный массив b, состоящий из элементов столбца i двумерного массива a, то можно использовать b = Application.Index(a, 0, i).
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 04.04.2011 в 18:03.
SAS888 вне форума Ответить с цитированием
Старый 04.04.2011, 20:46   #24
Hom_1985
 
Регистрация: 03.04.2011
Сообщений: 5
По умолчанию

Цитата:
Сообщение от SAS888 Посмотреть сообщение
Функция Application.Index(a, i, 0) вернет одномерный массив, состоящий из элементов строки i двумерного массива a.
Соответственно, функция Join(Application.Index(a, i, 0), "|") вернет строковую переменную, представляющую собой все элементы полученного одномерного массива, разделенные символом "|".
Таким образом, строковая переменная s = Join(Application.Index(a, i, 0), "|") будет содержать значения всех ячеек строки i в определенном диапазоне, разделенных указанным символом.
Именно эти значения мы и заносим в коллекцию. А как известно, коллекция не может содержать два одинаковых элемента. Таким образом, перехватывая возможную ошибку при добавлении элемента в коллекцию, мы определяем, встречался ли нам такой элемент ранее, или нет.

P.S. На будущее: если требуется получить одномерный массив b, состоящий из элементов столбца i двумерного массива a, то можно использовать b = Application.Index(a, 0, i).
спасибо большое. Благодаря этой методике я увеличил быстродействие своего другого скрипта с 30 секунд до 2 секунд.
Hom_1985 вне форума Ответить с цитированием
Старый 21.11.2014, 10:21   #25
OKfeed
Новичок
Джуниор
 
Регистрация: 21.11.2014
Сообщений: 2
По умолчанию

Sub Main()
Dim x As Range, y As New Collection, z As Range, i As Long, a(), s As String
Set z = Application.InputBox("Ввод/выбор", "Диапазон", Type:=8)
If z.Count = 1 Then Exit Sub Else a = z.Value
For i = 1 To UBound(a, 1)
s = Join(Application.Index(a, i, 0), "|")
On Error Resume Next: y.Add s, s
If Err <> 0 Then
If x Is Nothing Then Set x = z.Rows(i) Else Set x = Union(x, z.Rows(i))
On Error GoTo 0
End If: Next: x.EntireRow.Delete
End Sub

Макрос понравился. Как сделать чтобы он не удалял а очищал ячейки не во всей строке а до определенного столбца к примеру Q?
OKfeed вне форума Ответить с цитированием
Старый 21.11.2014, 12:08   #26
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
If x Is Nothing Then Set x = cells(i,1).resize(1,17) Else Set x = Union(x, cells(i,1).resize(1,17)
On Error GoTo 0
End If: Next: x.clearcontents
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

Последний раз редактировалось IgorGO; 21.11.2014 в 12:12.
IgorGO вне форума Ответить с цитированием
Старый 21.11.2014, 12:58   #27
OKfeed
Новичок
Джуниор
 
Регистрация: 21.11.2014
Сообщений: 2
По умолчанию

Большое спасибо!!!
OKfeed вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск одинаковых строк Demitriy Microsoft Office Excel 45 26.07.2010 08:50
Перенос строк по двойному клику в Excel 2003 Riddick Помощь студентам 8 15.12.2009 16:59
удаление одинаковых ссылок neoman1 Microsoft Office Word 6 30.11.2009 16:05
удаление одинаковых элементов из массива sauron99 Общие вопросы Delphi 6 15.04.2009 21:27
удаление одинаковых слов (С/С++) jewel Помощь студентам 1 12.12.2008 15:14