у меня в экселе таблица, данные, в таком порядке код - страна - цена и в поле КОД встречаются поля с одинаковыми кодами, но с разной ценой, надо убрать оттуда одинаковые коды, но чтоб скрипт из двух одинаковых кодов убрал то поле, в котором цена кода выше. За скрипт, макрос, или совет, который мне поможет реализовать данную операцию, готов заплатить. (цена ваша, в разумных пределах)
максрос: 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
Пашкела, что то он у меня не заработал , вроде правильно вживил в эксел. если тебе не сложно, не мог бы ты вживить макрос в эксел:??? Сам пытался вживить, то ли неправильно прописал, то ли в макросе ошибка проскользнула, не получилось у меня. Вот сам файл в который его надо прописать http://www.filehoster.ru/files/dk2057 Буду очень признателен, в долгу не останусь.
Да, вариант выше работал только на маленьком кол-ве записей. Или хз. В общем не стал дожидаться и переписал на более наглядный, невиснущий, позволяющий отследить результаты работы макрос: 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 Если что, пищи ------------------ Во время работы макроса лучше ничего не трогать, а тупо наслаждаться результатом
Сделаю небольшой совет. Чтобы все не висло, считывайте все данные в массив сразу, перед обработкой, потом обрабатывайте массив, потом чистите таблицу и вставляйте все заново на неё. Прирост скорости будет в десятки раз. (Тупит из за доступа к данным в таблице) И ище когда производятся операции в цикле и цикл может быть долгим, вставляйте оператор DoEvents. Это разблокирует интерфейс во время выполения ресурсоемких задач.
Пашкела, спасибо большое за макрос, только щас появилась возможность проверить, была проблема что макрос удаляет строки где цена ниже, с этим разобрался, заменил символ < в сравнении полей 3 и 4 на символ >. Но по окончанию процесса выявилась другая проблема. Когда макрос начинает сравнение полей, то полей 12 тысяч (задаются в теле макроса в поле "Номер последней строки в таблице"), после проверки макроса и удаления полей где цена выше, общее количество полей бывает примерно 9500, но тут Макрос зависает, потому что после последней строки под номером 9500, данных для обработки нет, а макрос должен обработать 12 тысяч полей. Можно ли сделать так, чтоб не надо было писать в макрос номер последней строки и он сам останавливался как только закончит обработку последнего поля вне зависимости от его номера??? Если есть возможность, исправь, пожалуйста, буду очень благодарен
Одну строчку сам не мог догадаться вставить чтоли? 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
Пашкела, наверное опять просьба к тебе , нужен макрос, который оставлял бы одинаковые строки и удалял бы строки, которые в файле не повторяются. например Тут нужно, чтоб макрос убрал код 316 и 31612 в первом столбце, который в файле один, и оставил повторяющиеся коды 31 31610 31611
Вообще, если не важны формулы, то намного проще экселевский файлик экспортировать в .csv , а дальше над ним можно извращаться практически на любом языке программирования так, как твоей душе угодно... ^^^^^^^^^^^^^^^^^^^^^^^^^ Это написано из-за того, что синтаксис Excel VBA мну раздражает ну прям ужос как
уже готово, всем спасибо. Если кому надо, выкладываю на всякий случай Вот весь код: Code: [color=darkblue]Sub[/color] test() [color=darkblue]Dim[/color] cell [color=darkblue]As[/color] Range, ra [color=darkblue]As[/color] Range, delra [color=darkblue]As[/color] Range Application.ScreenUpdating = [color=darkblue]False[/color] [color=darkblue]Set[/color] ra = Range([A1], Range("A" & Rows.Count).End(xlUp)) [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] ra.Cells [color=darkblue]If[/color] WorksheetFunction.CountIf(ra, cell) = 1 [color=darkblue]Then[/color] [color=darkblue]If[/color] delra [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] [color=darkblue]Set[/color] delra = cell [color=darkblue]Else[/color] [color=darkblue]Set[/color] delra = Union(delra, cell) [color=darkblue]End[/color] [color=darkblue]If[/color] [color=darkblue]Next[/color] cell [color=darkblue]If[/color] delra [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] MsgBox "На листе остались только повторяющиеся строки", 64: [color=darkblue]Exit[/color] [color=darkblue]Sub[/color] delra.EntireRow.Delete Application.ScreenUpdating = [color=darkblue]True[/color] [color=darkblue]End[/color] [color=darkblue]Sub[/color] А вот - пример файла с макросом: Отдельное спасибо за макрос EducatedFool
Не знаю куда написать, нашёл тему по поиску, напишу тут ) В общем у меня есть документ Excel, мне нужно в определённом столбце отобрать те строки, в которых значение больше 0. А которые с 0 удалить... Или сделать, где больше 0 чтобы были вверху, документ большой и искать в какой строке 1, а где 3 ручками не возможно. Как сделать? Хелп
