Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей.
Здесь обсуждаются безопасность, программирование, технологии и многое другое.
Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
 |
|
Макрос в эксел или PHP обработчик данных для формата .xls |
07.09.2009, 15:53
|
|
Moderator - Level 7
Регистрация: 06.02.2009
Сообщений: 195
Провел на форуме:
2485155
Репутация:
719
|
|
Макрос в эксел или PHP обработчик данных для формата .xls
у меня в экселе таблица, данные, в таком порядке
код - страна - цена
и в поле КОД встречаются поля с одинаковыми кодами, но с разной ценой, надо убрать оттуда одинаковые коды, но чтоб скрипт из двух одинаковых кодов убрал то поле, в котором цена кода выше.
За скрипт, макрос, или совет, который мне поможет реализовать данную операцию, готов заплатить. (цена ваша, в разумных пределах) |
|
|
07.09.2009, 17:08
|
|
Динозавр
Регистрация: 10.01.2008
Сообщений: 2,841
Провел на форуме:
9220514
Репутация:
3338
|
|
максрос:
PHP код:
Sub Макрос1()
Const intDataCol1 = 1 ' Номер столбца с кодами
Const intDataCol2 = 3 ' Номер столбца с ценами
Const intDataCol3 = 2 ' Номер столбца со странами
Const intMaxRow = 6 ' Номер последней строки в таблице
Dim i%, j%
Dim strValue1$, strValue2$, strValue3$, strValue4$, strValue5$, strValue6$
For i = 2 To intMaxRow - 1
strValue1 = Trim(Cells(i, intDataCol1))
strValue3 = Trim(Cells(i, intDataCol2))
For j = i + 1 To intMaxRow
strValue2 = Trim(Cells(j, intDataCol1))
strValue4 = Trim(Cells(j, intDataCol2))
If StrComp(strValue1, strValue2, vbTextCompare) = 0 Then
If strValue3 > strValue4 Then
Cells(j, intDataCol1).Delete shift:=xlUp
Cells(j, intDataCol2).Delete shift:=xlUp
Cells(j, intDataCol3).Delete shift:=xlUp
Else
Cells(i, intDataCol1).Delete shift:=xlUp
Cells(i, intDataCol2).Delete shift:=xlUp
Cells(i, intDataCol3).Delete shift:=xlUp
End If
End If
Next
Next
End Sub
Последний раз редактировалось Pashkela; 07.09.2009 в 17:18..
|
|
|
|
07.09.2009, 20:33
|
|
Moderator - Level 7
Регистрация: 06.02.2009
Сообщений: 195
Провел на форуме:
2485155
Репутация:
719
|
|
Пашкела, что то он у меня не заработал  , вроде правильно вживил в эксел.
если тебе не сложно, не мог бы ты вживить макрос в эксел:???
Сам пытался вживить, то ли неправильно прописал, то ли в макросе ошибка проскользнула, не получилось у меня.
Вот сам файл в который его надо прописать
http://www.filehoster.ru/files/dk2057
Буду очень признателен, в долгу не останусь. |
|
|
|
08.09.2009, 00:33
|
|
Динозавр
Регистрация: 10.01.2008
Сообщений: 2,841
Провел на форуме:
9220514
Репутация:
3338
|
|
Да, вариант выше работал только на маленьком кол-ве записей. Или хз. В общем не стал дожидаться и переписал на более наглядный, невиснущий, позволяющий отследить результаты работы макрос:
PHP код:
Sub Макрос1()
Const intDataCol1 = 1 ' Номер столбца с кодами
Const intDataCol2 = 3 ' Номер столбца с ценами
Const intMaxRow = 12700 ' Номер последней строки в таблице
Dim i%, j%
Dim strValue1$, strValue2$, strValue3$, strValue4$
For i = 2 To intMaxRow - 1
strValue1 = Trim(Cells(i, intDataCol1))
strValue3 = Trim(Cells(i, intDataCol2))
For j = i + 1 To intMaxRow
strValue2 = Trim(Cells(j, intDataCol1))
strValue4 = Trim(Cells(j, intDataCol2))
If StrComp(strValue1, strValue2, vbTextCompare) = 0 Then
If strValue3 > strValue4 Then
Rows(j & ":" & j).Select
Selection.Delete Shift:=xlUp
Else
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
End If
End If
Next
Next
End Sub
ну и рабочий вариант можно скачать здесь вместе с файлом:
типо тут
Просто зайти в Сервис->Макрос->Макросы->Макрос1->Выполнить
PS: Ждать придется долго, на то оно и vba
Если что, пищи 
------------------
Во время работы макроса лучше ничего не трогать, а тупо наслаждаться результатом
Последний раз редактировалось Pashkela; 08.09.2009 в 01:15..
|
|
|
|
08.09.2009, 11:43
|
|
Голос разума
Регистрация: 27.09.2006
Сообщений: 529
Провел на форуме:
1607210
Репутация:
1617
|
|
Сообщение от Pashkela
Да, вариант выше работал только на маленьком кол-ве записей. Или хз. В общем не стал дожидаться и переписал на более наглядный, невиснущий, позволяющий отследить результаты работы макрос:
PS: Ждать придется долго, на то оно и vba
Во время работы макроса лучше ничего не трогать, а тупо наслаждаться результатом
Сделаю небольшой совет.
Чтобы все не висло, считывайте все данные в массив сразу, перед обработкой, потом обрабатывайте массив, потом чистите таблицу и вставляйте все заново на неё. Прирост скорости будет в десятки раз.
(Тупит из за доступа к данным в таблице)
И ище когда производятся операции в цикле и цикл может быть долгим, вставляйте оператор DoEvents. Это разблокирует интерфейс во время выполения ресурсоемких задач.
__________________
Бойтесь своих желаний. Они могут исполниться....
...О-о-о-о, ушами не услышать, глазами не понять!
|
|
|
|
09.09.2009, 21:14
|
|
Moderator - Level 7
Регистрация: 06.02.2009
Сообщений: 195
Провел на форуме:
2485155
Репутация:
719
|
|
Пашкела, спасибо большое за макрос, только щас появилась возможность проверить, была проблема что макрос удаляет строки где цена ниже, с этим разобрался, заменил символ < в сравнении полей 3 и 4 на символ >.
Но по окончанию процесса выявилась другая проблема. Когда макрос начинает сравнение полей, то полей 12 тысяч (задаются в теле макроса в поле "Номер последней строки в таблице"), после проверки макроса и удаления полей где цена выше, общее количество полей бывает примерно 9500, но тут Макрос зависает, потому что после последней строки под номером 9500, данных для обработки нет, а макрос должен обработать 12 тысяч полей.
Можно ли сделать так, чтоб не надо было писать в макрос номер последней строки и он сам останавливался как только закончит обработку последнего поля вне зависимости от его номера???
Если есть возможность, исправь, пожалуйста, буду очень благодарен
Последний раз редактировалось satana-fu; 09.09.2009 в 21:36..
|
|
|
|
09.09.2009, 22:19
|
|
Динозавр
Регистрация: 10.01.2008
Сообщений: 2,841
Провел на форуме:
9220514
Репутация:
3338
|
|
Одну строчку сам не мог догадаться вставить чтоли?
PHP код:
Const intDataCol1 = 1 ' Номер столбца с кодами
Const intDataCol2 = 3 ' Номер столбца с ценами
Const intMaxRow = 12700 ' Номер последней строки в таблице
Dim i%, j%
Dim strValue1$, strValue2$, strValue3$, strValue4$
For i = 2 To intMaxRow - 1
strValue1 = Trim(Cells(i, intDataCol1))
strValue3 = Trim(Cells(i, intDataCol2))
If strValue1 = "" Then i = intMaxRow ' Волшебная строчка
For j = i + 1 To intMaxRow
strValue2 = Trim(Cells(j, intDataCol1))
strValue4 = Trim(Cells(j, intDataCol2))
If StrComp(strValue1, strValue2, vbTextCompare) = 0 Then
If strValue3 > strValue4 Then
Rows(j & ":" & j).Select
Selection.Delete Shift:=xlUp
Else
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
End If
End If
Next
Next
|
|
|
|
11.09.2009, 16:42
|
|
Moderator - Level 7
Регистрация: 06.02.2009
Сообщений: 195
Провел на форуме:
2485155
Репутация:
719
|
|
Пашкела, все заработал на отлично. спасибо большое, жду в личку номер вебмани
|
|
|
|
11.09.2009, 16:57
|
|
Динозавр
Регистрация: 10.01.2008
Сообщений: 2,841
Провел на форуме:
9220514
Репутация:
3338
|
|
оставь себе на пиво, просто интересно было
|
|
|
|
30.10.2009, 18:22
|
|
Moderator - Level 7
Регистрация: 06.02.2009
Сообщений: 195
Провел на форуме:
2485155
Репутация:
719
|
|
Сообщение от Pashkela
оставь себе на пиво, просто интересно было
Пашкела, наверное опять просьба к тебе , нужен макрос, который оставлял бы одинаковые строки и удалял бы строки, которые в файле не повторяются.
например
Тут нужно, чтоб макрос убрал код 316 и 31612 в первом столбце, который в файле один, и оставил повторяющиеся коды
31
31610
31611
Последний раз редактировалось satana-fu; 30.10.2009 в 18:30..
|
|
|
|
|
|
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|
Похожие темы
Линейный вид
