» Excel VBA (часть 3)

andrewkard1980
тысяча чертей!
но как?!?!

BeTheRED
Advanced VBA Password Recovery Pro (or simply AVPRP)

Vitus_Bering
Не угадали, зачем ломать если можно просто открыть...

Добавлено:
Вернее подбирать.

andrewkard1980

как бы то ни было, спасибо.
мой револьвер всегда к вашим услугам.

помогите с VBA скриптом, есть есть табличка с множеством столбцов и строк, нужно по трем столбцам найти совпадения и проставить какой-нибудь символ в пустой столбец(x символ 1).

у меня получается сравнить только первую строку со всей табличкой.

nss1= 2 '(начало таблички)'
nss2= nss1+ 1 '(начальная точка сравнения)'
Do While nss2 < nss '(кол-во строк)'
If Range("C" & nss1.Formula = Range("C" & nss2).formula And Range("U" & nss1).Formula = Range("U" & nss2.Formula And Range("V" & nss1).Formula = Range("V" & nss2).Formula Then
Range("X" & nss1).Formula = 1
Range("X" & nss2).Formula = 1
Else
End If
nss2 = nss2 + 1
Loop
мб как то массивами можно, туплю.

Anton V

Код: For nss1 = 1 To 1000
For nss2 = nss1 + 1 To 1000
If Range("C" & nss1) & Range("U" & nss1) & Range("V" & nss1) = _
Range("C" & nss2) & Range("U" & nss2) & Range("V" & nss2) Then
Range("X" & nss1) = 1
Range("X" & nss2) = 1
End If
Next
Next

aidomars
Спасибо огромное...

Уважаемые умельцы, прошу помочь в решении одной задачки. В VB не силён, поэтому приведу алгоритм, буду очень благодарен, если кто-то оформит его в макрос.

Имеется большая таблица длиной M строк. Необходимо произвести следующую работу.

1. i:=1

2. Пока строка D(i):G(i) не пустая, то:

2.1 Пока данные части строки D(i):G(i) совпадают (соответственно) с данными части следующей строки D(i+1):G(i+1) cтроку i+1 полностью удалить.
2.2 end

3 i:=i+1
4. end
5. end.

Короче говоря - таблицу надо почистить от строк, в которых идёт последовательный дубляж данных в столбцах от D до G.

Исправлено: защита от зацикливания в конце.

gjf, так вы его практически уже написали, похожий пример постом выше, а удаление просмотрите в коде через "Запись макроса".

aidomars
В примере организовано циклами for и проверками if.
Как в VB с условными циклами while?
Потому как по моей логике именно ими легче организовать процесс.

В VBA все тоже самое, что и везде. А For удобен тем, что в нем же идет перебор строк, в то время как в While для перехода по строкам надо дополнительно считать x=x+1.
Ваш пример лучше решить используя расширенный фильтр, имхо быстрее будет.

Код:
Sub УдалениеСтрок()
lastrow = Cells(Rows.Count, 4).End(xlUp).Row ' последняя строка в столбце 4
For i1 = 1 To lastrow
For i2 = i1 + 1 To lastrow
If Cells(i1, 4) & Cells(i1, 5) & Cells(i1, 6) & Cells(i1, 7) = _
Cells(i2, 4) & Cells(i2, 5) & Cells(i2, 6) & Cells(i2, 7) Then
Rows(i2).Select ' выделить строку
Rows(i2).Delete ' удалить строку
n = n + 1 ' считаем удаления
i2 = i2 - 1 ' сместить номер текущей строки выше
lastrow = lastrow - 1 ' сместить номер последней строки выше
End If
Next
Next
MsgBox "Удалено строк: " & n
End Sub

aidomars
Вы немного не поняли задачу. Речь о том, чтобы удалять не дубликаты по всему файлу, а только дубликаты-соседи.

Поэтому Ваш вариант макроса нужно изменить таким образом:

Код: Sub DelDouble1()
lastrow = Cells(Rows.Count, 5).End(xlUp).Row
    For i1 = 1 To lastrow
        i2 = i1 + 1
        While Cells(i1, 5) & Cells(i1, 6) & Cells(i1, 7) & Cells(i1, 8) & Cells(i1, 9) & Cells(i1, 10) & Cells(i1, 1)= Cells(i2, 5) & Cells(i2, 6) & Cells(i2, 7) & Cells(i2, 8) & Cells(i2, 9) & Cells(i2, 10) & Cells(i2, 1)
                Rows(i2).Select
                Rows(i2).Delete
                lastrow = lastrow - 1
        Wend
    Next
End Sub

Наверное лучше между Cells(i1, 5) & Cells(i1, 6) установить какой-то разделитель, а то могут быть ошибки типа
Cells(i1, 5) = 112
Cells(i1, 6)=211

и

Cells(i1, 5) = 11
Cells(i1, 6)=2211

Что не совсем равно друг другу...


Добавлено:
Rows(i2).Select
Rows(i2).Delete
Выделять строку перед удалением не обязательно, можно сразу

Rows(i2).Delete


Добавлено:
Для удаления дубликатов лучше идти с конца в начало:

For i1 = lastrow to 1 step -1

andrewkard1980 (00:00 10-04-2013)
Цитата:

Наверное лучше между Cells(i1, 5) & Cells(i1, 6) установить какой-то разделитель, а то могут быть ошибки

Принимается. Все цифры в указанных столбцах меньше 100, таким образом разделителем может быть, например, 888:

Код: Sub DelDouble1()
lastrow = Cells(Rows.Count, 5).End(xlUp).Row
For i1 = 1 To lastrow
i2 = i1 + 1
While Cells(i1, 5) & 888 & Cells(i1, 6) & 888 & Cells(i1, 7) & 888 & Cells(i1, 8) & 888 & Cells(i1, 9) & 888 & Cells(i1, 10) & 888 & Cells(i1, 11)= Cells(i2, 5) & 888 & Cells(i2, 6) & 888 & Cells(i2, 7) & 888 & Cells(i2, 8) & 888 & Cells(i2, 9) & 888 & Cells(i2, 10)& 888 & Cells(i2, 11)
Rows(i2).Delete
lastrow = lastrow - 1
Wend
Next
End Sub

gjf

Цитата:

для числовых данных операция & - это логическое И или просто слияние строки?

Сцепление строк только. Логическое И это And (оно же бинарное умножение).
Не совсем понятно, что делается? Нужно оставить только уникальные строки по столбцам 5,6,7,8,9,10 или удаляются только идущие подряд?

gjf, разделитель обычно "|" использую я.

AndVGri
Удаляются идущие подряд с одинаковым содержимым в 6 столбцах.

Добавлено:
Если слияние, тогда код легче сделать с символом.

Код: Sub DelDouble1()
lastrow = Cells(Rows.Count, 5).End(xlUp).Row
For i1 = 1 To lastrow
i2 = i1 + 1
While Cells(i1, 5) & '|' & Cells(i1, 6) & '|' & Cells(i1, 7) & '|' & Cells(i1, 8) & '|' & Cells(i1, 9) & '|' & Cells(i1, 10) & '|' & Cells(i1, 11)= Cells(i2, 5) & '|' & Cells(i2, 6) & '|' & Cells(i2, 7) & '|' & Cells(i2, 8) & '|' & Cells(i2, 9) & '|' & Cells(i2, 10)& '|' & Cells(i2, 11)
Rows(i2).Delete
lastrow = lastrow - 1
Wend
Next
End Sub

gjf
Может так будет по шустрее (хотя и здесь есть возможность ускорить)

Код:
Private Function GetKey(ByVal forThis As Variant) As String
Dim i As Long, sResult As String
For i = 1 To UBound(forThis, 2)
sResult = sResult & CStr(forThis(1, i)) & ":"
Next i
GetKey = sResult
End Function

Public Sub RemoveDubs()
Dim sLast As String, sKey As String
Dim vLastRow As Long, i As Long, pRows As Range
vLastRow = Cells(Rows.Count, 5).End(xlUp).Row
i = 1: sLast = "": Set pRows = Nothing
For i = 1 To vLastRow
sKey = GetKey(Range(Cells(i, 5), Cells(i, 11)).Value)
If sKey = sLast Then
If pRows Is Nothing Then
Set pRows = Rows(i)
Else
Set pRows = Application.Union(pRows, Rows(i))
End If
Else
sLast = sKey
End If
Next i
If Not pRows Is Nothing Then pRows.Delete Shift:=xlUp
End Sub

Пробую спарсить данные с proxies by/raw_free_db.htm?0&i=rule2
При попытке извлечь исходный текст данной страницы результат нулевой - извлекается исходный текст, но без нужного содержимого. Как я понимаю для обработки содержимого нужно формировать запросы (get / post) и получать ответы от сервера с нужным содержимым.

Подскажите, есть ли какие-либо надстройки и/или может быть дополнительные библиотеки для VBA Excel, чтобы удобно было извлекать данные с web страниц, формировать get post запросы ?

Maximmuss
Почему Вы решили что не все? Попробуйте записать ответ в текстовый файл, в окне Immediate иногда не все отображается.

gjf
Пробуйте так,

Код:
Sub DelDouble1()
lastrow = Cells(Rows.Count, 5).End(xlUp).Row
Application.ScreenUpdating = False
For i1 = lastrow To 2 step -1
i2 = i1 - 1
If Cells(i1, 5) & "|" & Cells(i1, 6) & "|" & Cells(i1, 7) & "|" & Cells(i1, 8) & "|" & Cells(i1, 9) & "|" & Cells(i1, 10) & "|" & Cells(i1, 11) = Cells(i2, 5) & "|" & Cells(i2, 6) & "|" & Cells(i2, 7) & "|" & Cells(i2, 8) & "|" & Cells(i2, 9) & "|" & Cells(i2, 10) & "|" & Cells(i2, 11) Then
Rows(i2).Delete
End If
Next i1
Application.ScreenUpdating = True
End Sub

Помогите разобратся с методом POST, не могу получить данные web страницы, вот код:

Код:
Set oHTTP = CreateObject("MSXML2.XMLHTTP")
oHTTP.Open "POST", "http://makler.md/ru/an/list/search/publisher/14/category/107/page/0", False
oHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
oHTTP.SetRequestHeader "Host", "makler.md"
oHTTP.SetRequestHeader "Referer", "http://makler.md/ru/nikolaev/real-estate/apartments"
sURL = "page=0&field_172=0&field_172-1=102&field_172_min=0&field_172_max=102&selector=search&field_169=0&field_169-1=12&field_169_min=0&field_169_max=12&price_min=0&price_max=2046210&text=&order=&direction="
oHTTP.Send sURL
sHTML = oHTTP.responseText
Set oHTTP = Nothing

Люди добрые. помогите, плиз, написать такой скриптик, чтобы в эксель, например, все Листы переименованы, по фамилиям пускай.

а можно ли эти листы переименовать:
чтобы было так:

автоматически, а не вручную по отдельности.

Futurism
Как то так...

Код: For i = 1 To Sheets.Count
Sheets(i).Name = "List" & i
Next

Цитата:

Помогите разобратся с методом POST

andrewkard1980 а не пробовал вытащить текст со страницы с авторизацией?
Например баланс с сайта МТС?
У меня вышло только через WebBrowser1, тот еще гемор.

dneprcomp
спасибо за код). Но тут есть одна проблема, в этом эксель файле уже встроен другой макрос.
я прикреплю его и когда я выполняю его, то они как будто конфликтуют.
например, вот сам файл.
http://webfile.ru/6484508.
В чем тут может быть дело или что я неправильно делаю?

Futurism
Код должен быть помещен в Sub. В General можно только переменные объявлять.

http://webfile.ru/6484814

dneprcomp
а понял, спасибо огромное, теперь все ок)

aidomars
Наверное только через WebBrowser1, там же нужно форму отправлять на сервер, хотя может и есть способ по лучше, если увидеть что именно отправляет сайт и отправить то же самое. Пробовать надо.

andrewkard1980
Так форма и отправляет данные на сервер через GET и POST. А Firebug показывает что отправлено и получено. Но чет не выходит у меня.