{quote}{login=KukLP}{date=26.05.2012 08:15}{thema=}{post}8-[ Sub www_3()... End Sub{/post}{/quote} Спасибо, работает! Последний вопрос - не соображу, как настроить макрос на диапазон 62-66 (BJ:BN), что ещё надо изменить в макросе кроме "j = 62 To 66 Step 2"?
PS. Ещё раз - спасибо за терпение и проверьте почту, пожалуйста.
"ДОБАВЛЯЛИСЬ" - означает, что данные из чётного столбца необходимо добавить в левый, нечётный столбец за уже содержащимися там данными (извините, если не вполне корректно объяснил суть проблемы, т.к. посчитал, что принцыпа работы приведённого в начале ветки макроса достаточно для понимания...) По новой версии макроса: первое копирование - корректное (единственно что, для начала отсчёта понадобилось заполнить в столбцах 9ю строку (иначе с 1й строки начинал копирование. Второе копирование - ровно с конца забитых формулами диапазонов... =( Третье с тем же смещением (книгу с новым макросом приаттачил) В-принципе, можно перевести копируемые столбцы в значения и должно пойти. Хотя, лишних 30.000 ячеек...
Интересный макрос. Вопросы, если можно: 1. Столбцы копирует, но строго в конце исходников с формулами, что несколько неудобно: столбцы в 10.000 строк. Можно, конечно, сместить Offset(-10001, -7), перестроив предварительно структуру столбцов, но хотелось бы структуру не менять - слишком много завязок. 2. Копирует с ЗАМЕНОЙ данных, а необходимо, чтобы столбцы ДОБАВЛЯЛИСЬ. Это можно как-то решить? Спасибо!
:-/ Применить в деле сей макрос так и не сумел... Во-первых, в флормульном варианте(SpecialCells(-4123)) он тупо копирует ЦЕЛИКОМ все столбцы с формулами... ОК, перевёл столбцы на значения. SpecialCells(2), макрос нАчал копировать, но: первое копирование корректное, второе с оффсетом в 4000 (!) строк 8-(. Третье ещё + 4000... Все столбцы девственно чистые, никаких УФ, никаких заливок и границ. Где грабли? И ещё: если поставить SpecialCells(2, 2), то, почему-то наотрез отказывается копировать 2 столбец из 3х Пример привести не могу - файл слишком большой.
Может всё-таки кто-то подскажет, как уговорить приведённый мною в начале ветки макрос отрабатывать добавление данных по трём столбцам? Уж очень он удобный и надёжный - и с формулами и со значениями без проблем работает...
ээээ... Видимо, надо было уточнить, что пополняемые данные в столбцах B, D и F прописаны формулами. Прошу прощения. К сожалению, Ваш макрос, KukLP, с формулами не работает...=( Может как-нибудь можно довести до ума приведённый мною выше вариант?
Моё почтение! С очередной проблеммкой обращаюсь к специалистам... Есть рабочий макрос, добавляющий в столбец А данные со столбца В:
Sub Uptate1_() Dim LastRow As Long, Rw As Long, j As Integer, i As Long Rw = 10 LastRow = Cells(Rows.Count, 1).End(xlUp).Row For j = 1 To 2 LastRow = Cells(Rows.Count, j).End(xlUp).Row For i = 10 To LastRow If Cells(i, j).Value <> "" Then Cells(Rw, 1) = Cells(i, j).Value Rw = Rw + 1 End If Next Next End Sub
Желательно расширить задачу, чтобы макрос не только из B в A добавлял, но и из D в C, а также из F в E.
Пробовал банально продублировать макрос 3 раза со смещением задания на "j":
Sub Uptate1__() Dim LastRow As Long, Rw As Long, j As Integer, i As Long Rw = 10 LastRow = Cells(Rows.Count, 1).End(xlUp).Row For j = 1 To 2 LastRow = Cells(Rows.Count, j).End(xlUp).Row For i = 10 To LastRow If Cells(i, j).Value <> "" Then Cells(Rw, 1) = Cells(i, j).Value Rw = Rw + 1 End If Next Next For j = 3 To 4 LastRow = Cells(Rows.Count, j).End(xlUp).Row For i = 10 To LastRow If Cells(i, j).Value <> "" Then Cells(Rw, 3) = Cells(i, j).Value Rw = Rw + 1 End If Next Next For j = 4 To 5 LastRow = Cells(Rows.Count, j).End(xlUp).Row For i = 10 To LastRow If Cells(i, j).Value <> "" Then Cells(Rw, 4) = Cells(i, j).Value Rw = Rw + 1 End If Next Next End Sub
не получается, макрос выполняет только первое задание... Скорее всего, всё очень просто должно решиться, да вот знаний пока маловато...
{quote}{login=ikki}{date=18.05.2012 09:04}{thema=}{post}...если при защите листа в списке "Разрешить всем пользователям этого листа" установить галочку "форматирование ячеек", то проблема исчезает....{/post}{/quote}Да, вполне рабочий вариант...=). Единственно что, появляется возможность случайного перефоратирования ячеек, что нежелательно.. Спасибо =)
{quote}{login=k61}{date=18.05.2012 03:09}{thema=Пароль - "Танк"}{post}Private Sub Worksheet_SelectionChange(ByVal Target As Range) ... Unprotect Password:="Танк" ... Protect Password:="Танк" End If End Sub{/post}{/quote} Интересно, что Эксель не даёт по ходу пользования страницей сменить пароль - что забил сначала в "исходный текст", то и ставит/снимает защиту, даже при смене в макросе пассворда. Спасибо за информацию: беру на вооружение =)
Столкнулся тут с неприятностью: по окончании работы над таблицей выяснилось, что установленный на лист стандартный макрос для работы в НЕ условном форматировании:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("I10:I1009")) Is Nothing Then Target.Font.Name = "Marlett" If Target = vbNullString Then Target = "a" Else Target = vbNullString End If End If End Sub
после установки защиты перестаёт работать, выдаёт ошибку шрифта: " '1004', Нельзя установить свойства Name класса Font" Диапазон с Марлеттом - без защиты стоит, но работать отказывается... Есть таблетка от сей болезни, или придётся программу в "беззащитном" варианте выпускать? Очень бы не хотелось......
Вас устроит такая "сортировка"? Меня нет. Тем более, что в гуляющих по сети прокси-листах до фига дублей скрытых в прокси-адрессах с доменными именами (пример: в приаттаченом образце, если Вы заметили, программа отыскала 12 скрытых дублей). Возможно и есть в сети программки выполняющие те же функции, что и IPБ, но я таких пока не встречал.
Выкладываю здесь кусочек программы, собранной на Экселе, предназначенной для работы со списками прокси-серверов. Всё - freeware. Сделал её сам, с помощью людей, которых упомяну ниже.
Для чего нужна эта программка? Кто активно пользуется прокси-серверами, в курсе, как напрягает постоянно меняющаяся база рабочих проксей; сортировка, занудные массовые копипасты рабочих/нерабочих, выделение из рабочих проксей Соксов; их (Соксов) вредная привычка переходить в не-Соксовое состояние и обратно, оперативный перенос нужных списков или одиночных ИПшников в прокси-менеджеры (типа Proxy Switcher'а) и ещё: куча клочков бумаги на столе...;) Особо эта смарт-табличка поможет тем, кто не любит пользоваться public проксями, то есть, предпочитает сканить диапы сам. Поскольку я сам иногда занимаюсь прокси-охотой, а ничего похожего для реализации своих потребностей в сети не нашёл, решил сам заняться оптимизацией процесса сортировки всё возрастающей горы списков прокси-серверов.
В приведённом архиве первая половинка программы (самая навороченная, кстати, дальше проще будет). Здесь мы сможем: 1.Убрать все дубликаты 2.Пропарсить содержимое (убрать весь не относящийся к делу мусор) 3.Перевести доменные имена в IPшные (для этого необходимо наличие интернета) 4.Аранжировать список по возрастанию IP и по портам 5.Готовый список можно симпортировать в .txt файл
Кухню - не скрывал, чтобы было удобнее понять, как оно работакт... Вторая часть, предназначенная для более детальной работы со списками проксей готова примерно наполовину и скоро, с Божией помощью, будет опубикована. =)
Буду признателен всем тем, кто поможет довести программку до ума, ускорить и (или) упростить код.
ПО РАБОТЕ ПРОГРАММЫ:
Прокси-листы вносим либо копипастом в ячейку В10, либо экспортируем из текстового файла нажимая на пимпу "Импорт" (в архиве есть файл Образец.txt с 450 строчным прокси-листом для примера). Кнопка "Сортировка" помещает в столбец D все "правильные" прокси. Все прокси-адреса обозначенные доменными адресами можно перевести в обычный вид нажатием на кнопку "Фильтр" (результат поместится в столбец F), кроме того, фильтрация отпарсит список и пометит голубым цветом все повторы в столбцах D и F. Кнопка "Компиляция" совместит два столбца в один (Н), отсортирует IP по возрастанию, по портам и удалит все повторы. Кнопка "Экспорт" сохранит очищенный и отсортированный прокси лист в текстовай файл в дерикторию, в которой находится файл IPБ.xls (Имя .txt файлу присваивается автоматически, по дате и времени создания). Кпопка "Очистить" полностью очищает таблицу от загруженных данных..... Вроде всё.
Мега-респекты специалистам в Excel'е, без которых сей продукт никогда бы не смог попасть в сеть:
EducatedFool; The_Prist; Казанский; Михаил С.; Юрий М; ikki; Hugo; Дъмитръ; и многие другие (простите, если кого позабыл)...
На вопросы, если они будут, с удовольствием отвечу; критику приму с благодарностью (а она наверняка будет - первый блин, как-никак ;) ).
Всё получилось =))) Скорость у макроса - отменная, в зависимости от заполненности проверяемого диапазона, макс. 12 секунд работает... Единственно на чём время потерял, когда внедрял макрос, не учёл, что условное форматирование по умолчанию в приоритете - пока не снёс все условия в УФ, ничего не выделялось... Век живи - век учись.
Да, всё, для чего этот сыр-бор затевал, наполовину уже готово. Чуть попозже залью на депозит, дам здесь ссылку: интересно будет мнение спецов узнать. Ну и, улачшить, если что.....
Если достопочтеннейшая публика не будет возражать, задам пару вопросов Уважаемому Михаилу С. (вопросы, возможно и "детские", но что уж тут - неча на зеркало пенять, коль в жизни занимался всем, чем угодно, кроме Экселя...;) ).
Пытаюсь тут приладить Ваш макрос к своим конкретным целям. Результаты пока - не очень. Никак не могу заставить макрос обрабатывать не весь лист, а ТОЛЬКО конкретные столбцы. Изъял из макроса тайминг (итак ясно, что всё максимально быстро обсчитывается); пытался обозначить нужный диапазон, но не срослось как-то...=( Пересчитывает всё равно все данные по листу. Перекуроченый мною, Ваш код:
Sub Moy_Macros() Dim mArr, myDict, i, k, u1, u2, l Set myDict = CreateObject("Scripting.Dictionary") myDict.CompareMode = vbTextCompare mArr = Sheets(1).UsedRange.Value With Range("B:E") u1 = UBound(mArr, 1): u2 = UBound(mArr, 2) For i = 1 To u1 For l = 1 To u2 If mArr(i, l) <> "" Then If myDict.Exists(mArr(i, l)) Then k = k + 1: myDict.Item(mArr(i, l)) = 1 Else myDict.Add Key:=mArr(i, l), Item:=0 End If End If Next: Next Application.ScreenUpdating = False For i = 1 To u1: For l = 1 To u2 If mArr(i, l) <> "" Then If myDict.Item(mArr(i, l)) Then UsedRange.Cells(i, l).Interior.ColorIndex = 8 End If Next: Next End With Application.ScreenUpdating = True End Sub
Где косяк? Как задать макросу точный диапазон для компарирования?
ЗЫ. И ещё - зачем в конце макроса стоИт "Application.ScreenUpdating = True", если в начале "False" не ставили?
{quote}{login=Михаил С.}{date=07.05.2012 01:09}{thema=Hugo}{post}Игорь, не самый оптимальный вариант. На массивах работает быстрее. Пример в файле.{/post}{/quote}
Работает и очень быстро! =) 90%, что прилАжу Ваш код в свою программку.
ЗЫ.Один вопрос, почему сброс цвета во 2м Вашем макросе переводит столбцы в красивый голубенький цвет? %) По идее, "Color = xlNone" должно было обесцветить ячейки до белого?
{quote}{login=Hugo}{date=07.05.2012 09:25}{thema=}{post}Извиняюсь, забыл про файл в начале темы...
Option Explicit
Sub tt() Dim a(), el, cnt& a = Sheets(1).UsedRange.Value With CreateObject("System.Collections.ArrayList") For Each el In a If Len(Trim(el)) Then If Not .Contains(el) Then .Add (el) Else cnt = cnt + 1 End If End If Next End With MsgBox cnt & " повторов." End Sub{/post}{/quote}
Попробовал - выносит с 429 ошибкой: "AcnbveX component can't create object" У меня 2003 Эксель. Может он под это дело не заточен?
{quote}{login=ikki}{date=07.05.2012 01:12}{thema=}{post}гм... так я и не понял, на что мне не следует обижаться?.. %-[] или следует?.. всё равно не понял.{/post}{/quote} [off] Да ладно, пустое.... =))) Вот, зарегился. Чотта подсказало, что так оно правильнее будет...=) Всех с наступающим!!!