Вроде получилось, сравнил с количеством строк сводной таблицы совпадает, проверил пошаговое (F8) тоже правильно удаляет. Проверьте ещё самостоятельно. -Нажмите на кнопку -Будет создана копии листа -Выберете диапазон удаления лишних строк с одинаковыми данными в 3 диалоговых окнах (если во всем соглашаться, то первый столбец(=А=1) от начала до конца(=0)) -Макрос- Повтор_Del_LS_4 самостоятельно назначите как Вам удобно. Рабочий диапазон подкрашивается.
Скопируйте код макроса или уделите в предыдущем код аналогичный красному. Спойлер (Наведите указатель мыши на Спойлер, чтобы раскрыть содержимое) Раскрыть Спойлер Свернуть Спойлер Sub Повтор_Del_LS_5() Dim St As String Dim Str As Integer Dim bbB Dim aaA Dim b As Integer Dim a As Integer 'чтобы не копировался лист удалите красный код, изи “заремить” (или “закомментировать”) 'Копирование листа 'nnsh = Worksheets.Count 'определение количества листов в книге 'nsh = ActiveSheet.Name 'определение имени листа 'Sheets(nsh).Copy Before:=Sheets(nnsh) 'Ввод диапазон St = "A" St = InputBox("Введите Имя столбца (A,B,C,D,E,F...)", "Ввод столбца", St) Str = 1 Str = InputBox("Введите номер первой строки (...1,2,3,...100,..)", "Ввод строки", Str) LastRow = 0 LastRow = InputBox("Введите номер Последнейй строки (если 0, то до конца ...100, 305...)", "Ввод строки", LastRow) If LastRow = 0 Then LastRow = Range("a:a").CurrentRegion.Rows.Count End If 'Цвет диапазона Range("A" + CStr(Str) + ":" + St + CStr(LastRow)).Select With Selection.Interior .ColorIndex = Int(11 * Rnd + 34) .Pattern = xlSolid End With Range(St + CStr(Str) + ":" + St + CStr(LastRow)).Select With Selection.Interior .ColorIndex = Int(11 * Rnd + 34) .Pattern = xlSolid End With 'Циклы перебора в диапазоне и удаление строк при повторении из заданного столбца Application.ScreenUpdating = False 'без обновления изображения For b = Str To LastRow bbB = Range(St + CStr(b)).Value Range(St + CStr(b + 1)).Select Application.ScreenUpdating = False 'без обновления изображения For a = b + 1 To LastRow Range(St + CStr(a)).Select aaA = ActiveCell.Value 'nnnn = Range("A" + CStr(a - 1)).Value If bbB = aaA Then 'Range("A" + CStr(a)).Select Application.ScreenUpdating = True Selection.EntireRow.Delete 'Range("A" + CStr(a - 1)).Select 'Selection.EntireRow.Delete 'ActiveCell.Offset(-1, 1).Select Application.ScreenUpdating = False 'без обновления изображения a = a - 1 LastRow = LastRow - 1 Else: End If If a >= LastRow Then GoTo lbl1006 End If Next a lbl1006: 'Str = b If b >= LastRow Then GoTo lbl1007 End If Application.ScreenUpdating = True Next b lbl1007: Range("b3").Select ActiveWindow.SmallScroll Down:=-LastRow ActiveCell.Offset(-1, -1).Select 'n = InputBox("Введите количество точек ", "Ввод", n) End Sub Я решил попробовать сделать более основательно. К концу недели может быть выложу.
Alexandr-GR, Сделал так, чтобы можно было удалять полностью совпадающие строки, или по данным в нескольких столбцах (до 8). На листе "Параметры" выбираются критерии поиска одинаковых данных в выбранных столбцах для удаления или анализа, лишних строк. Новый макрос называется Tab_Analyze_Del_UnRows (третья кнопка - смайлик). В данный момент параметры настроены под Вашу задачу. Настроил два старых макроса и один новый на кнопки в персональной книге макросов. Она должна загружаться, если скопировать её вC:\Documents and Settings\Пользователь\Application Data\Microsoft\Excel\XLSTART Протестируйте, предложения, замечания, вопросы ...
С помощью функции у меня не получается, только "условное форматирование". Но это не на много хуже, достаточно сделать формат для одной ячейки, а далее использовать формат по образцу. "Условное форматирование" можно настроить по условию или по формуле. (См пример в загруженном выше файле, предварительно сняв защиту листа).
kub13, попробовал... 1. В архиве лежит 3 файла: в PERSONAL.TXT написано: - Папка XLSTART на W7 находится немного по-другой директории (это мелочи - можно воспользоваться поиском); - После вставки файла в указанное место, при выполнении макроса, программа выдает сообщение, что не может найти PERSONAL.XLS, поэтому после копирования необходимо переименовать PERSONAL_KUB13.XLS в PERSONAL.XLS, после этих манипуляций макрос работает... .... это я о самом запуске Работа макроса впечатляет - прикольно наблюдать за процессом, перебором ячеек (это я без иронии, а то меня уже однажды понимали неправильно) Но у меня при выполнении макроса "Tab_Analyze_Del_UnRows", почему то после анализа и окрашивания ячеек не удаляются повторяющиеся позиции, хотя в параметрах все необходимое выставлено... Я так подозреваю, что привязка к строкам по-прежнему осталась (и в некоторых случаях именно так и надо). А вот можно ли добавить возможность удалять ячейку (без удаления строки)?
Добавил файл для переноса панели инструментов. Немного добавил ещё впечатления. Не понял почему, что вообще не вырезает строки? Я делал в Екселе 2003, но проверял на работе и на 2010, всё работает. Операционная система везде XP. Да, результат такой же как и прежде. Только когда ставишь галочки сразу для нескольких столбцов, строка удаляется при условии если полностью совпали со всеми соответствующими ячейками из сравниваемой строки (при условии если стоит галочка на удаление). Здесь мне не совсем понятно: 1-удалять любое данные при совпадение, как при закрашивании? 2-удалять данные во всей строке, при совпадении всех критериев? 3-удалять данные, при совпадении всех критериев, только в ячейках отмеченных галочкой? 4-или другие соображения? Пункт № 1 и 2 это вообще не проблема. Пункт №3 чуть-чуть посложнее. Если так, то тогда надо ещё сделать вариант закрашивания, например в красный цвет ячейки, только полностью совпадающие с критериями поиска в очередной строке, кроме первой сравниваемой. Хотел сделать интуитивно понятный интерфейс выбора критериев поиска и анализа. На сколько это получилось? Может быть предложите своё видение доступного для понимания интерфейса в параметрах выбора критериев поиска. Если снять защиту листа, то можно раскрыть структуру и посмотреть на мои не внедрённые задумки.
Спасибо! Ув. kub13, представьте себя на месте других - допустим, EXELем приходится плотно работать изредка. Изучать все эти форматирования и скакать по меню? Когда надо решить задачу за час-полчаса? Вот, поэтому и привлекает VBA. Пока не до него...
Это всё понятно. Только заготовить универсальный и всё предусматривающий макрос сложновато. Любая задача обусловлена многими вопросами и запросами. Скиньте для начала хотя бы файлик с примером и Вашим видением результата. Работает верно, но только с одним столбцом и поднимает нижние ячейки вверх. Поэтому они безвозвратно "уходят" от своих строк. Надо сменить удаление ячеек на удаление строк.
не знаю как остальным, мне лично доставляет большое удовольствие смотреть на процесс да.. да.. именно это я и имел в виду.. удаление повторяющихся значений в массиве (диапазоне), но в тоже время не исключая опции (возможности) с удалением строк, т.е. не убирая то, что есть сейчас... По мне так у Вас это получилось - все понятно и наглядно. Спасибо!
Оффтоп (Move your mouse to the spoiler area to reveal the content) Проблему решили с пикетами? Так понял Leica работаете? Если неясно еще как это сделать, пишите, раскажу.
Alexandr-GRДумаю окончательный вариант, добавил ещё варианты выбора, в том числе запрашиваемые, хотя как я понимаю это очень не логичный и опасный выбор. Вместо справки вставил примечание, чтобы было более понятно. Если будут пожелания, пишите. Напоминаю речь идёт о программе для поиска, анализа и удаления нижерасположенных повторяющихся ("лишних") строк с одинаковыми данными, в выбранных столбцах таблицы. В следующих сообщения представлены изменённые варианты программы (Модератор).
Думал окончательный вариант, но уже сделал насколько изменений в настройках. Поэтому просьба вышерасположенный файл не скачивать. Выкладываю обновлённый архив, и с примерами обработки.
Все как-то нет времени, будет конкретная задача - обязательно скину. Не нужен универсальный макрос. Моя идея в следующем - можно иметь набор файлов на *.BAS на VBA, где собираются разные удачные функции, проверенные в работе. (Как у кодеров - библиотеки функций и шаблоны) Исходный код подробно документируется в комментах. Имена функций именуются по определенным правилам (чтобы устранить конфликты при объединении текстов и при вызове в таблицах) и т. д. К примеру Function GNSS.Bottom_height_from (Measured_height, NGS_Aht_type as string, Method as string) и т. п. Лично мне это гораздо удобнее, чем хранить таблицы EXCEL, а потом долго в них разбираться - что там я задавал в каких ячейках. Ув kub13, собственно вопрос: Как лучше манипулировать этими файлами? У меня ситуация такая - в одном файле создал модуль VBA, написал там несколько функций. Работают. Куда-то дел этот файл.Сохранил в файлы *.BAS разные наборы функций. В другом файле решал другую задачу, работают. Файл тоже где-то покрылся мхом, но опять сохранил в файлы *.BAS разные наборы функций. Теперь, создаю чистую таблицу EXCEL и думаю туда подключить оба файла BAS, чтобы юзать нужные функции. На первом же файле выдает сообщение - типа, такие функции уже есть. Признаться, думал, что сохраненные в редакторе Вижл Бэйсик функции действительны только для текущей таблицы... Получается, они запомнены Экселем где-то в общих файлах? Мне это не надо. Как лучше работать, общие правила создания и сохранения макросов не подскажете? Методом тыка буду долго изучать, да и не факт, что потом не вылезет какая-нибудь проблема. С мануалами и хелпом возиться - уйму ненужного прочтешь, а потом опять методом тыка выяснять;)
Никогда не возникало таких проблем. Макросы создаются или в конкретной книге или в персональной книге макросов (PERSONAL.XLS). Скорее всего это ваш вариант, но книгу PERSONAL.XLS видно в редакторе VBA, в окне VBAProject. Можно удалить из неё ненужные макросы или модули. Данная книгу, если она не нужна тоже можно удалить или переместить, чтобы она не загружалась при каждом запуске Excel. Расположена она по адресу: C:\Documents and Settings\Пользователь\Application Data\Microsoft\Excel\XLSTART или C:\Program Files\Microsoft Office\OFFICE11\XLSTART Можно ещё создать надстройку, чтобы функции были невидимые, я это не использовал.
kub13, а также, кто знает, не затруднить ответить на вопрос лентяя? (Разбираться методом тыка некогда...) Как организовать в VBA цикл, последовательно перебирающий номера ячеек в качестве аргумента? В теле цикла надо выбрать очередную ячейку и сделать с ней некие действия. к примеру Range("G16").Select - а как указать перебор G10, G11, G12, не делая манипуляций с преобразованием строкового выражения, обозначающего ячейку? Такая хрень не работает: For I = 1 To 100 For J = 1 To 100 Range(RICJ).Select
