Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Расширяем работу макроса на соседние пары столбцов...
 
{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х  
Пример привести не могу - файл слишком большой.  
 
Может всё-таки кто-то подскажет, как уговорить приведённый мною в начале ветки макрос отрабатывать добавление данных по трём столбцам? Уж очень он удобный и надёжный - и с формулами и со значениями без проблем работает...
"
Расширяем работу макроса на соседние пары столбцов...
 
Увы,  
"Run-time error '1004'"  
=(((
"
Расширяем работу макроса на соседние пары столбцов...
 
ээээ...  
Видимо, надо было уточнить, что пополняемые данные в столбцах 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  
 
не получается, макрос выполняет только первое задание...  
Скорее всего, всё очень просто должно решиться, да вот знаний пока маловато...
"
CheckBox на рабочем листе.
 
Вдогонку: если чекбоксов много, все их можно перевести в одно из состояний следующим макросом:  
 
Sub MassOnOff()  
   Dim sha As Shape: On Error Resume Next  
   For Each sha In ActiveSheet.Shapes  
       sha.OLEFormat.Object.Value = 0  
   Next sha  
End Sub  
 
, где значение "Value =" переводит чекбоксы в состояние:  
0 - нет    
1 - да  
2 - неопределено
"
НеУФ: Марлетт не работает под защитой... Смириться?
 
{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"  
Диапазон с Марлеттом - без защиты стоит, но работать отказывается...  
Есть таблетка от сей болезни, или придётся программу в "беззащитном" варианте выпускать?  
Очень бы не хотелось......
"
IPБ - программка для работы с прокси-листами
 
{quote}{login=mizantrop}{post}Тот же проксисвитчер и парсит и сортирует по одному клику.{/post}{/quote}  
Ну да, сортирует. Примерно так:  
 
1.167.94.42:3128  
189.82.3.203:3128  
2.237.160.145:8080  
217.39.97.164:8080  
251.65.169.12:80  
85.154.187.87:1080  
85.154.187.87:12437  
85.154.187.87:3128  
85.154.187.87:80  
 
Вас устроит такая "сортировка"? Меня нет.    
Тем более, что в гуляющих по сети прокси-листах до фига дублей скрытых в прокси-адрессах с доменными именами (пример: в приаттаченом образце, если Вы заметили, программа отыскала 12 скрытых дублей). Возможно и есть в сети программки выполняющие те же функции, что и IPБ, но я таких пока не встречал.
"
IPБ - программка для работы с прокси-листами
 
Доброго всем дня!  
 
Выкладываю здесь кусочек программы, собранной на Экселе, предназначенной для работы со списками прокси-серверов.    
Всё - freeware.  
Сделал её сам, с помощью людей, которых упомяну ниже.  
 
Скачать бету можно здесь:    
http://depositfiles.com/files/j6st79enx  
 
Для чего нужна эта программка?  
Кто активно пользуется прокси-серверами, в курсе, как напрягает постоянно меняющаяся база рабочих проксей; сортировка, занудные массовые копипасты рабочих/нерабочих, выделение из рабочих проксей Соксов; их (Соксов) вредная привычка переходить в не-Соксовое состояние и обратно, оперативный перенос нужных списков или одиночных ИПшников в прокси-менеджеры (типа 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" должно было обесцветить ячейки до белого?
"
Безбожно тормозит УФ. Ищу альтернативу макросом...
 
Пардон.  
"ActiveX component...."
"
Безбожно тормозит УФ. Ищу альтернативу макросом...
 
{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]
Да ладно, пустое.... =)))  
Вот, зарегился.    
Чотта подсказало, что так оно правильнее будет...=)  
Всех с наступающим!!!
"
Страницы: 1
Наверх