Форум АНТИЧАТ
Страница 1 из 2 1 2 >
Показывать 40 сообщений этой темы на одной странице

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)
-   PHP, PERL, MySQL, JavaScript (https://forum.antichat.xyz/forumdisplay.php?f=37)
-   -   Макрос в эксел или PHP обработчик данных для формата .xls (https://forum.antichat.xyz/showthread.php?t=139942)

satana-fu 07.09.2009 15:53
Макрос в эксел или PHP обработчик данных для формата .xls
 
у меня в экселе таблица, данные, в таком порядке

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


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


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

Pashkela 07.09.2009 17:08
максрос:

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 

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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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 

satana-fu 11.09.2009 16:42
Пашкела, все заработал на отлично. спасибо большое, жду в личку номер вебмани

Pashkela 11.09.2009 16:57
оставь себе на пиво, просто интересно было

satana-fu 30.10.2009 18:22
Цитата:
Сообщение от Pashkela
оставь себе на пиво, просто интересно было
Пашкела, наверное опять просьба к тебе :rolleyes: , нужен макрос, который оставлял бы одинаковые строки и удалял бы строки, которые в файле не повторяются.

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

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

31
31610
31611


Время: 00:40
Страница 1 из 2 1 2 >
Показывать 40 сообщений этой темы на одной странице