Макрос в эксел или PHP обработчик данных для формата .xls

[satana-fu]

у меня в экселе таблица, данные, в таком порядке

код - страна - цена
http://s46.radikal.ru/i114/0909/76/0aaa96430903.jpg


и в поле КОД встречаются поля с одинаковыми кодами, но с разной ценой, надо убрать оттуда одинаковые коды, но чтоб скрипт из двух одинаковых кодов убрал то поле, в котором цена кода выше.


За скрипт, макрос, или совет, который мне поможет реализовать данную операцию, готов заплатить. (цена ваша, в разумных пределах)

[Pashkela]

максрос:


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

[satana-fu]

Пашкела, что то он у меня не заработал :rolleyes: , вроде правильно вживил в эксел.
если тебе не сложно, не мог бы ты вживить макрос в эксел:??? :rolleyes:


Сам пытался вживить, то ли неправильно прописал, то ли в макросе ошибка проскользнула, не получилось у меня.

Вот сам файл в который его надо прописать
http://www.filehoster.ru/files/dk2057


Буду очень признателен, в долгу не останусь.:rolleyes:

[Pashkela]

Да, вариант выше работал только на маленьком кол-ве записей. Или хз. В общем не стал дожидаться и переписал на более наглядный, невиснущий, позволяющий отследить результаты работы макрос:


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


ну и рабочий вариант можно скачать здесь вместе с файлом:

типо тут (http://bug-track.ru/prog/123.rar)

Просто зайти в Сервис->Макрос->Макросы->Макрос1->Выполнить

PS: Ждать придется долго, на то оно и vba

Если что, пищи:)

------------------

Во время работы макроса лучше ничего не трогать, а тупо наслаждаться результатом

[SQLHACK]

Да, вариант выше работал только на маленьком кол-ве записей. Или хз. В общем не стал дожидаться и переписал на более наглядный, невиснущий, позволяющий отследить результаты работы макрос:

PS: Ждать придется долго, на то оно и vba

Во время работы макроса лучше ничего не трогать, а тупо наслаждаться результатом

Сделаю небольшой совет.
Чтобы все не висло, считывайте все данные в массив сразу, перед обработкой, потом обрабатывайте массив, потом чистите таблицу и вставляйте все заново на неё. Прирост скорости будет в десятки раз.
(Тупит из за доступа к данным в таблице)

И ище когда производятся операции в цикле и цикл может быть долгим, вставляйте оператор DoEvents. Это разблокирует интерфейс во время выполения ресурсоемких задач.

[satana-fu]

Пашкела, спасибо большое за макрос, только щас появилась возможность проверить, была проблема что макрос удаляет строки где цена ниже, с этим разобрался, заменил символ < в сравнении полей 3 и 4 на символ >.

Но по окончанию процесса выявилась другая проблема. Когда макрос начинает сравнение полей, то полей 12 тысяч (задаются в теле макроса в поле "Номер последней строки в таблице"), после проверки макроса и удаления полей где цена выше, общее количество полей бывает примерно 9500, но тут Макрос зависает, потому что после последней строки под номером 9500, данных для обработки нет, а макрос должен обработать 12 тысяч полей.

Можно ли сделать так, чтоб не надо было писать в макрос номер последней строки и он сам останавливался как только закончит обработку последнего поля вне зависимости от его номера???

Если есть возможность, исправь, пожалуйста, буду очень благодарен :rolleyes:

[Pashkela]

Одну строчку сам не мог догадаться вставить чтоли?


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

[satana-fu]

Пашкела, все заработал на отлично. спасибо большое, жду в личку номер вебмани

[Pashkela]

оставь себе на пиво, просто интересно было

[satana-fu]

оставь себе на пиво, просто интересно было

Пашкела, наверное опять просьба к тебе :rolleyes: , нужен макрос, который оставлял бы одинаковые строки и удалял бы строки, которые в файле не повторяются.

например
http://s57.radikal.ru/i156/0910/66/649cd9638734.jpg

Тут нужно, чтоб макрос убрал код 316 и 31612 в первом столбце, который в файле один, и оставил повторяющиеся коды

31
31610
31611

[login999]

Вообще, если не важны формулы, то намного проще экселевский файлик экспортировать в .csv , а дальше над ним можно извращаться практически на любом языке программирования так, как твоей душе угодно...
^^^^^^^^^^^^^^^^^^^^^^^^^
Это написано из-за того, что синтаксис Excel VBA мну раздражает ну прям ужос как

[satana-fu]

нужен макрос, который оставлял бы одинаковые строки и удалял бы строки, которые в файле не повторяются.

например
http://s57.radikal.ru/i156/0910/66/649cd9638734.jpg

Тут нужно, чтоб макрос убрал код 316 и 31612 в первом столбце, который в файле один, и оставил повторяющиеся коды

31
31610
31611


Кодеры, помогите плиз, кто с макросами разбирается???? Срочняк нужен макрос, оплату гарантирую :rolleyes:

[satana-fu]

уже готово, всем спасибо. Если кому надо, выкладываю на всякий случай


Вот весь код:
Sub test()
Dim cell As Range, ra As Range, delra As Range
Application.ScreenUpdating = False
Set ra = Range([A1], Range("A" & Rows.Count).End(xlUp))
For Each cell In ra.Cells
If WorksheetFunction.CountIf(ra, cell) = 1 Then
If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
End If
Next cell
If delra Is Nothing Then MsgBox "На листе остались только повторяющиеся строки", 64: Exit Sub
delra.EntireRow.Delete
Application.ScreenUpdating = True
End Sub


А вот - пример файла с макросом:

http://excelvba.ru/Screenshots/JPG__02-11-2009__17-36-18.JPG (http://excelvba.ru/XL_Files/Sample__02-11-2009__17-36-16.zip)


Отдельное спасибо за макрос EducatedFool

[Flanker48]

Не знаю куда написать, нашёл тему по поиску, напишу тут )

В общем у меня есть документ Excel, мне нужно в определённом столбце отобрать те строки, в которых значение больше 0. А которые с 0 удалить... Или сделать, где больше 0 чтобы были вверху, документ большой и искать в какой строке 1, а где 3 ручками не возможно. Как сделать? Хелп

[Pashkela]

Данные-фильтр-автофильтр

PS: ппц:)