Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Простые макросы за простые деньги...
 
#1
15.12.2011 18:08:21
Это следствие темы "Как создать взаимосвязанные файлы Эксель К "  
 
Юрий М, пожалуйста не удаляйте эту тему... У вас есть прекрасная возможность, чтобы я навсегда изчез из поля вашего зрения...  
 
Да, я понимаю разумом что Прист логичен... По существу, не в деталях...    
Сегодня ехал в автобусе и женщине с ребёнком не уступили место, тогда водитель посадил ребёнка возле коробки передач..  
 
Я как бы об этом...  
 
Да не лентяй я...  
 
И вы Юрий М, в чём-то правы... В чём-то, но не совсем... Это внешне кажется, что потребительское...  
 
Да плачу я...    
 
Посмотрел историю платежей по Яндекс-деньги - уже 600 рублей истратил... А результата нет... Вот сейчас заплатил 100 рублей за макрос удаления дубликатов с некоторыми нюансами...  
Запустил... У меня копм с оперативкой 2 гига... Сижу.., зеваю.., жду.., когда же удалятся дубли... 20 минут жду.., жду.., уж полночь близится, а Германа всё нет... Мало того, пытался через диспетчер выключить комп, а он говорит "Невозможно закрыть Эксель".. Пришлось принудительно перезагружать...  
 
Юрий, мой стиль объясняется тем что невозможно два дела делать хорошо...  
Ну да, я плохо знаю Эксель, понимая его безграничные возможности, но зато я знаю, что этот год для вас был связан с переменой места, а для KukLP, год связан с мягкостью, уступчивостью и согласием...  
Ну один знает хорошо одно, другой другое - каждый должен знать своё дело...  
Это как нельзя любить двух женщин одинаково...  
 
Какое там потребительское отношение... Мне за деньги делают не всегда как надо...    
 
Может кто-нибудь найдётся, кто за небольшие деньги (от 100 рублей) будет мне писать простые макросы ? На форумах попадаются дилетанты, от макросов которых зависает приличный комп...  
 
Приму любые предложения, на длительной, стабильной, постоянной основе (особенно, при их инкогнито - от Юрий М и The_Prist, хотя вряд ли их устроят те суммы которые я могу предложить)..  
 
Моя аська 376856720  
volshebnik (собачка) london . com  
 
Ниже скину ссылку на две актуальные программы...  
 
1-я, это то, что нужно сейчас... То, с чем предыдущий программист не справился...  
 
С уважением...
 
 
 
#2
15.12.2011 18:11:47
И вторая проблема... Приблизительно, она выглядит вот так...  
 
В последствии ещё потребуются макросы...  
 
Оплата, либо на мобильник, либо через Яндекс-деньги...  
 
С уважением...
 
 
 
#3
15.12.2011 18:15:09
По первой. Суть изложена, а данных нет. А данные, знаете ли, разные бывают...  
Сколько планируете потратить на решение первой?
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#4
15.12.2011 18:17:30
Волшебник, вот совсем рядом тема про сравнение столбцов - разницы практически нет.  
Только в количестве столбцов.  
Алгоритм - зелёный диапазон в словарь, затем розовый по словарю проверяем.  
Если добавить массивы - будет в 40 раз быстрее.
 
 
 
#5
15.12.2011 18:18:28
Если конфиденциальность данных не позволяет выложить их на форум, мое мыло в подписи.
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#6
15.12.2011 18:21:08
Hugo, Игорь, да таких тем не то, что каждую неделю, чуть ли не каждый день создают) Но, если человек хочет "отблагодарить", это его право : )
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#7
15.12.2011 18:22:30
Вторая задача сразу испугала...  
Но работа по ТЗ внушает уважение :)  
 
У меня нет мобильника и яндекса - поэтому удаляюсь... :)
 
 
 
#8
15.12.2011 18:27:10
Нерв, все даннные в txt... Если я правильно понимаю... На 1-ю 100 рублей, там где нужно удалить дубли с ньюансами...  
 
Не знаю много или мало это... Просто потребность в макросах как снежный ком нарастает... И если я что-то упустил, то оплата апгрейдов отдельно...  
 
Деньги могу прям сейчас перечислить...  
 
С уважением...
 
 
 
#9
15.12.2011 18:29:45
Hugo  
 
"Если добавить массивы - будет в 40 раз быстрее."  
 
Я не понимаю этого... Мне нужен готовый лист с макросом, чтобы я вложил данные и он их обработал...  
 
С уважением...70
 
 
 
#10
15.12.2011 18:33:16
Волшебник_, можно пример с данными по первой задаче на мыло? А то не совсем понятно, о каких столбцах Вы говорите, если это txt : )
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#11
15.12.2011 18:35:08
По 1-й проблеме, сходу без тестирования:  
 
Sub ClearDups1()  
 Dim Rng1 As Range, Rng2 As Range, a(), c&, cs&, k$, r&, rs&, x  
 With ActiveSheet.UsedRange  
   Set Rng1 = .Columns("A:B")  
   Set Rng2 = .Columns("C:H")  
 End With  
 a = Rng1.Value  
 rs = UBound(a, 1)  
 cs = UBound(a, 2)  
 With CreateObject("Scripting.Dictionary")  
   .CompareMode = 1  
   For r = 1 To rs  
     For c = 1 To cs  
       k = Trim(a(r, c))  
       If Len(k) Then  
         .Item(k) = 0  
       End If  
     Next  
   Next  
   a = Rng2.Value  
   For r = 1 To rs  
     For c = 1 To cs  
       k = Trim(a(r, c))  
       If Len(k) Then  
         If .Exists(k) Then  
           a(r, c) = Empty  
         End If  
       End If  
     Next  
   Next  
 End With  
 Rng2.Value = a()  
 Rng2.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp  
End Sub
 
 
 
#12
15.12.2011 18:40:05
nerv, можно как я там делал - проверил:  
 
Sub tt()  
Dim i&  
For i = 1 To 8  
UsedRange.Columns(i).Select  
Next  
End Sub  
 
В массив их, в словарь и перебор...  
Впрочем, кого учу :)
 
 
 
#13
15.12.2011 18:41:40
По второй задаче. Задание не совсем понятно. Также интересен бюджет.  
 
Что не ясно:  
0. С какими данными придется работать.  
1. "Открыть файл" - какой? Эксель?  
2. "Исключить из поиска счёт" - что за счет?  
3. "Найти мин. и макс. кол-во символов в ячейках" т.е., ячейки, кот. содержит от СТОЛЬКО_ТО_СИМВОЛОВ до СТОЛЬКО?  
4. "Задать для поиска кол-во символов:" почти дубль предыдущего. За чем?  
5. "Найти различия на кол-во символов:" тут надо конкретизировать, что подразумевается под различиями, и какими они могу быть.  
Пример:  
"троллейбус" - а тут ай-яй-яй.  
"троль" - тут разница в одни символ  
И что с чем сравнивать? Первое слово со вторым или второе с первым? И это еще относительно простой пример. Вообще, нечеткий поиск - штука достаточно ресурсоемкая...
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#14
15.12.2011 18:59:01
Владимир [ZVI], приветствую! Как вариант
 
//вместо  
k = Trim(a(r, c))  
If Len(k) Then  
 
//так  
k = Trim(a(r, c))  
If k <> "" Then  
 
Почти одно и тоже, но вызовов встроенных функцией vba меньше ; )  
 
 
Игорь[Hugo], учиться надо всегда) Я вот сейчас js учу : )
 
 
Пользуясь случаем, хотел бы еще раз сказать "спасибы" Вам, Владимиру и всем всем всем Планетянам, за то, что помогаете в трудную минуту ; )
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#15
15.12.2011 20:04:23
{quote}{login=Волшебник_}{date=15.12.2011 06:08}{thema=}{post}я знаю, что этот год для вас был связан с переменой места{/post}{/quote}:-) Волшебник, ни место жительства, ни место работы я не менял. Вы о чём? :-)
 
 
 
#16
15.12.2011 20:20:56
Юрий, вы что Россию на Израиль хотите променять? )))) Сказали об этом только Волшебнику, а нам нет? ))
 
 
 
#17
15.12.2011 20:34:52
Пока не планировал, но у Волшебника другие данные :-)
 
 
 
#18
15.12.2011 20:53:36
{quote}{login=Волшебник_}{date=15.12.2011 06:08}{thema=Простые макросы за простые деньги...}{post}...невозможно два дела делать хорошо...  
{/post}{/quote}Волшебник, какой-то Вы неправильный :-)  
Волшебники, ИМХО, могут больше чем другие :-)  
И уж точно несколько дел одновременно.
 
 
 
#19
15.12.2011 20:56:13
{quote}{login=Юрий М}{date=15.12.2011 08:34}{thema=}{post}Пока не планировал, но у Волшебника другие данные :-){/post}{/quote}Сеня, ты зачем сбрил усы? ©
 
 
 
#20
15.12.2011 22:06:12
>>Может кто-нибудь найдётся, кто за небольшие деньги (от 100 рублей) будет мне писать простые макросы ?    
А что, на форуме мало людей, имеющих почту в подписи? Ни с кем договориться не получилось? Особенно "на длительной, стабильной, постоянной основе".
 
 
 
#21
15.12.2011 22:34:37
Мне кажется, что на этом форуме "простыми макросами" всех "отоварили", никто неудовлетворённым не остался :)
 
 
 
#22
16.12.2011 02:37:17
ZVI  
 
ZVI, попробовал ваш макрос, но, он удалил 25% дублей... Я вот думаю, может число рабочего пространства не до конца листа ?  
У меня данными забиты все обозначенные столбцы до отказа...  
Можно ли выставить максимальное кол-во рабочего пространства в 65536 строк ?  
Я глянул код, не могу сообразить куда нужно вставить это число...  
 
Пожалуйста...  
 
С уважением...
 
 
 
#23
16.12.2011 06:33:33
{quote}{login=nerv}{date=15.12.2011 06:59}{thema=}{post}Владимир [ZVI], приветствую! Как вариант
 
//вместо  
k = Trim(a(r, c))  
If Len(k) Then  
 
//так  
k = Trim(a(r, c))  
If k <> "" Then  
 
Почти одно и тоже, но вызовов встроенных функцией vba меньше ; ){/post}{/quote}  
Доброй ночи, Александр. А чего их бояться, вызовов встроенных функцией vba? Они полезны  :-)  
Вы любите тестировать на скорость выполнения разные конструкции кода, протестируйте Ваше предложение и поймете, в чем смысл моего.
 
 
 
#24
16.12.2011 06:38:05
{quote}{login=Волшебник_}{date=16.12.2011 02:37}{thema=}{post} ...он удалил 25% дублей...{/post}{/quote}  
Уточните, пожалуйста, сколько это в штуках.  
Мой вопрос не праздный, данных я не видел, поэтому могу лишь предполагать вероятные причины, количество дубликатов - одна из вероятных причин.
 
 
 
#25
16.12.2011 07:36:26
ZVI  
 
Мне неловко даже говорить) - макрос убрал 25% дублей из 24 тысяч дублей...  
 
Я это проверил замечательным макросом, который, в прошлой теме, то ли вы сделали, то ли это макрос Hugo, но я вставляю в него данные и он копируя дубли в другие, не исходные столбцы, в итоге сообщает кол-во дублей...  
 
Вот он    
 
Sub ClearDups3()  
Dim a(), c&, cs&, k$, r&, rs&, x&  
 
a = ActiveSheet.Range("A:J").Value  
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))  
rs = UBound(a, 1)  
cs = UBound(a, 2)  
With CreateObject("Scripting.Dictionary")  
.CompareMode = 1  
For r = 1 To rs  
For c = 1 To cs  
k = Trim(a(r, c))  
If Len(k) Then  
If .Exists(k) Then  
b(r, c) = a(r, c)  
x = x + 1  
Else  
.Add k, 0  
End If  
End If  
Next  
Next  
End With  
ActiveSheet.Range("L:U").Resize(UBound(b)).Value = b()  
MsgBox "Количество повторов " & x  
End Sub  
 
После фильтрации данных вашим последнимо макросом, я пропустил результат через этот макрос - он то и сообщил мне что если вначале было 24 тысячи дублей, то потом - 18 тысяч...  
 
С уважением...
 
 
 
#26
16.12.2011 08:43:04
ZVI  
 
Сижу сейчас за монитором - и рот до ушей).. Всё получилось !!!  
 
Я учёл вашу мысль что может данных как бы много... И пропустил через ваш макрос все свои данные, но вставлял только по одному столбцу... Поэтапно...  
 
Затем проверил предыдущим макросом - кол-во дублей оказалось "0" )  
 
Блеск !!!    
 
Хороший макрос, вообще ваши макросы отличаются шустротой и быстротой)..  
 
ZVI большое вам спасибо).. Закончилась неделя удаления дубликатов).. Такой душевный подъём).. Подскажите пожалуйста, номер кошелька на Яндекс-деньгах)..    
 
С искренним уважением), лично к вам)
 
 
 
#27
16.12.2011 13:42:44
Кошельками не пользуюсь, купите лучше что-нибудь Вашей маме :-)  
Подправил макрос, чтобы не было ограничений на максимальное количество дубликатов:  
 
Sub ClearDups2()  
 Const st& = 16000  
 Dim Rng1 As Range, Rng2 As Range, a(), c&, cs&, k$, r&, rs&  
 With ActiveSheet.UsedRange  
   Set Rng1 = .Columns("A:B")  
   Set Rng2 = .Columns("C:H")  
 End With  
 a = Rng1.Value  
 rs = UBound(a, 1)  
 cs = UBound(a, 2)  
 With CreateObject("Scripting.Dictionary")  
   .CompareMode = 1  
   For r = 1 To rs  
     For c = 1 To cs  
       k = Trim(a(r, c))  
       If Len(k) Then  
         .Item(k) = 0  
       End If  
     Next  
   Next  
   a = Rng2.Value  
   For r = 1 To rs  
     For c = 1 To cs  
       k = Trim(a(r, c))  
       If Len(k) Then  
         If .Exists(k) Then  
           a(r, c) = Empty  
         End If  
       End If  
     Next  
   Next  
 End With  
 Rng2.Value = a()  
 With Application  
   .ScreenUpdating = False  
   .EnableAnimations = False  
   .Calculation = xlCalculationManual  
   For c = 1 To cs  
     For r = rs To 1 Step -st  
       i = r - st:  If i < 0 Then i = 0  
       Rng2.Columns©.Resize(st).Offset(i).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp  
     Next  
   Next  
   .ScreenUpdating = True  
   .EnableAnimations = True  
   .Calculation = xlCalculationAutomatic  
 End With  
End Sub
 
 
 
#28
16.12.2011 13:51:36
Подправил немного:  
 
Sub ClearDups2()  
 Const st& = 16000  
 Dim Rng1 As Range, Rng2 As Range, a(), c&, cs&, k$, r&, rs&  
 With ActiveSheet.UsedRange  
   Set Rng1 = .Columns("A:B")  
   Set Rng2 = .Columns("C:H")  
 End With  
 a = Rng1.Value  
 rs = UBound(a, 1)  
 cs = UBound(a, 2)  
 With CreateObject("Scripting.Dictionary")  
   .CompareMode = 1  
   For r = 1 To rs  
     For c = 1 To cs  
       k = Trim(a(r, c))  
       If Len(k) Then  
         .Item(k) = 0  
       End If  
     Next  
   Next  
   a = Rng2.Value  
   For r = 1 To rs  
     For c = 1 To cs  
       k = Trim(a(r, c))  
       If Len(k) Then  
         If .Exists(k) Then  
           a(r, c) = Empty  
         End If  
       End If  
     Next  
   Next  
 End With  
 Rng2.Value = a()  
 With Application  
   .ScreenUpdating = False  
   .EnableAnimations = False  
   .Calculation = xlCalculationManual  
   On Error Resume Next  
   For c = 1 To cs  
     For r = rs To 1 Step -st  
       i = r - st:  If i < 0 Then i = 0  
       Rng2.Columns©.Resize(st).Offset(i).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp  
     Next  
   Next  
   .ScreenUpdating = True  
   .EnableAnimations = True  
   .Calculation = xlCalculationAutomatic  
 End With  
End Sub
 
 
 
#29
17.12.2011 09:37:22
ZVI  
 
Закончилась эпоха удаления дубликатов).. Около недели бился над этой проблемой)  
Именно благодаря вам эта проблема наконец окончательно решилась...  
 
ZVI, спасибо вам, от чистого сердца)..  
 
С большим уважением)..
 
 
 
Страницы: 1
Читают тему
Наверх