Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
Парсинг html
 
Чем провинился?

Вот такой Pattern должен быть:
Код
myRegExp.Pattern = "card__author-name.*?(\n.*?)\n.*?<"
 
где \n это новая строка
Парсинг html
 
Здравствуйте!
С парсингом одной строки проблем нет, но тут столкнулся с интересной штукой, и ничего не выходит.
HTML:
Код
<span class="card__author-name">    
            Дмитрий          
   </span> 
Кусок кода:
Код
myRegExp.MultiLine = True
myRegExp.Global = True  
myRegExp.IgnoreCase = True  
myRegExp.Pattern = "card__author-name.*?$(^.*?$)^.*?<"
и...ничего не получается ((( думаю проблема в правильной расстановке начала и конца строк - $ и ^ , а может и не в этом...
подскажите пожалуйста.
Массив из диапазона ячеек
 
Ага, включил отображение окна, View - Locals Window
Понаблюдаю что это такое )) до этого без него писал код
Массив из диапазона ячеек
 
Цитата
Hugo пишет: Если бы тормознули код после заполнения массива и заглянули в Locals - думаю всё стало бы понятно.
Неудобно признаваться, не понимаю где это (((
Еще раз спасибо, много прояснили.
Массив из диапазона ячеек
 
Спасибо всем большое!
Понял что массив из диапазона ячеек оказывается двухмерным. Думал просто а(1 to 10) вот же ж как )))) думал двумерные начинаются когда 2 или больше строк/столбцов.  
Массив из диапазона ячеек
 
Цитата
V пишет: Ubound(a) (то же самое что UBound(a, 1)) выдает скажем так к-во строк, а UBound(a, 2) к-во столбцов.
Все равно не догоняю, почему так.
Читаю тут: http://msdn.microsoft.com/ru-ru/library/95b8f22f(v=vs.90).aspx
И не понимаю какой у меня массив получился...(1 to 1, 1 to 1, 1 to 1, ...) и так 10 раз?
Пример из ссылки:
Код
Dim a(100, 5, 4) As Byte 
UBound(a, 1) возвращает 100
UBound(a, 2) возвращает 5
UBound(a, 3) соответственно 4

Я тут и не могу разобраться, у меня какой массив получился )))
Массив из диапазона ячеек
 
Цитата
Юрий М пишет: Вы хотите теперь из массива во вторую строку на лист выгрузить циклом данные? Тогда так:
да, именно это хочу. Но почему так? Не понимаю ((
Таааак, я могу спороть чушь, но я правильно понял что этот массив получился не (1 to 10), а (10, 1) ???

JayBhagavan, походу так ))) тогда массив (1, 10) получается?...
Ладно, всем спасибо!!! Направление "копания" понял, хотя бы понял что гуглить
Изменено: sinus - 04.11.2014 23:23:30
Массив из диапазона ячеек
 
Тогда
Код
 For i = 1 to Ubound(a)  
   .Cells(2, i) = a(i) 
Next
не работает...subscript out of range...не могу уловить суть ошибки.
Ubound ведь возвращает информацию о верхней границе массива (номер последнего имеющегося значения), по идее 10 (диапазон же из 10 ячеек).
Просветите пожалуйста, весь день гуглю, у всех эти примеры работают, у меня нет.
Даже в моей старой теме Hugo писал, один в один пример...
Массив из диапазона ячеек
 
я хочу чтобы он занес поочередно ячейки A1, B1, C1, ..., J1 в массив a
Массив из диапазона ячеек
 
Код
Sub test()
    Dim a()
    With Sheets("Лист1")
        a = .Range("A1:J1").Value
        MsgBox UBound(a)
    End With
End Sub 
Я думал MsgBox UBound(a) должен выдать 10, а выдает 1, подскажите почему так?
Все ячейки заполнены в этом диапазоне, пустых нет.
Авторизация на сайте с помощью WinHttpRequest, Как склеить несколько заголовков Cookie
 
Низкий поклон, Игорь.
С байтовым массивом никогда бы не допетрил.
Впервые о нем услышал ))))
Авторизация на сайте с помощью WinHttpRequest, Как склеить несколько заголовков Cookie
 
Доковырялся ))))
Ошибка (80070459)
Символ Юникода не имеет сопоставления в конечной многобайтовой кодовой странице
Как ни странно, гугл ответа не дал ((
Код
.Open "GET", Location$, False 
.setRequestHeader "Host", "krsk.24au.ru"     
.setRequestHeader "Connection", "keep-alive"     
.setRequestHeader "Cache-Control", "max-age=0"    
.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"     
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.124 Safari/537.36"     
.setRequestHeader "Referer", "http://common.24au.ru/login/"     
.setRequestHeader "Accept-Encoding", "gzip , deflate, sdch"     
.setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"     
.setRequestHeader "Cookie", cookie$     
.send       
cookie$ = .getResponseHeader("Set-Cookie") 
auth = cookie$    
htmlau = .responseText     
Open "C:\test.txt" For Output As #1   
Print #1, htmlau   
Close #1 
Ругается на  .responseText  
Помогите у кого была такая проблема, как решали?
Авторизация на сайте с помощью WinHttpRequest, Как склеить несколько заголовков Cookie
 
Prist спасибо, но ошибку высвечивало на строке:
Код
For Each .getResponseHeader("Set-Cookie") In .getAllResponseHeaders() 
поставил амперсанд, но непонятно что произошло )))
Игорь, допилил немножко код, то cookie$ начиналось с ;
Код
cookie$ = ""
        For Each header In Split(.getAllResponseHeaders(), vbNewLine)
            If header Like "Set-Cookie:*" Then
                If cookie$ = "" Then
                cookie$ = Mid(header, 12)
                Else
                cookie$ = cookie$ & "; " & Mid(header, 12)
                End If
            End If
        Next
 
куки передаются вроде правильно теперь, но авторизация все равно не происходит, видимо где то с заголовками косяк у меня, или вообще у них на сайте какая то хитрушка с авторизацией.
За помощь с кукисами огромное спасибо!
Авторизация на сайте с помощью WinHttpRequest, Как склеить несколько заголовков Cookie
 
здравствуйте Игорь! спасибо что откликнулись )) в том то и проблема что в cookies$ попадает только первый заголовок set-cookies.
и ошибку в коде вы указали правильно, vba ругается имеено в том месте
Авторизация на сайте с помощью WinHttpRequest, Как склеить несколько заголовков Cookie
 
Вот ответ сайта:
Цитата
HTTP/1.1 302 Found Server: nginx
Date: Sun, 05 Oct 2014 05:42:30 GMT
Content-Type: text/html; charset=utf-8
Content-Length: 131
Connection: keep-alive
Keep-Alive: timeout=20
Cache-Control: private
Location: http://24au.ru
X-AspNetMvc-Version: 3.0
X-AspNet-Version: 4.0.30319
Set-Cookie: Hy701jhkafgPOOYWoehf=346361558F578934C6DDB9182D28E6329737246­33EAE037CB16B1859BE0D43905DB01491DF3938D106A6CBD7C967926807F­F9B5B2B1C6F0B77D269E6B665AB40; domain=.24au.ru; path=/; HttpOnly
Set-Cookie: m_auth=0E4E522DDF280B295655C6A195928745; domain=.24au.ru; path=/; HttpOnly
Set-Cookie: e8839924dda2757bd102e60b15c66777=A7D6D04C-A07E-48D6-9EE7-42F8B0B14D2B; domain=24au.ru; expires=Sat, 05-Oct-2024 05:42:32 GMT; path=/ Set-Cookie: is_adult=0; domain=24au.ru; expires=Sun, 05-Oct-2014 17:42:32 GMT; path=/
Не могу склеить несколько заголовков кукисов (((
Код
Function auth() As String
    ' возвращает идентификатор сессии в случае удачной авторизации,  или пустую строку при ошибке
   On Error Resume Next
    Dim oXMLHTTP As New WinHttpRequest
    With oXMLHTTP
        ' первый запрос - для получения идентификатора сессии
       .Open "GET", "http://krsk.24au.ru/", False
       .setRequestHeader "Host", "krsk.24au.ru"
       .setRequestHeader "Connection", "keep-alive"
       .setRequestHeader "Cache-Control", "max-age=0"
       .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
       .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.124 Safari/537.36"
       .setRequestHeader "Referer", "http://krsk.24au.ru/"
       .setRequestHeader "Accept-Encoding", "gzip , deflate, sdch"
       .setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
       .send
       
        For Each .getResponseHeader("Set-Cookie") In .getAllResponseHeaders()
        cookie$ = cookie$ + .getResponseHeader("Set-Cookie")
        Next
        
       If Not cookie$ Like "*SessionId=*" Then
            MsgBox "Ошибка получения идентификатора сессии", vbCritical, "Обратитесь к разработчику программы"
            Exit Function
        End If

        ' отключаем редирект
       .Option(WinHttpRequestOption_EnableRedirects) = False
        ' второй запрос - для авторизации
       .Open "POST", "http://common.24au.ru/login/", False
        PostData = "ReturnUrl=http://krsk.24au.ru/&UserName=" & Пользователь & "&Password=" & Пароль & "&RememberMe=false"
        
        .setRequestHeader "Host", "common.24au.ru"
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Content-Length", "88"
        .setRequestHeader "Cache-Control", "max-age=0"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
        .setRequestHeader "Origin", "http://krsk.24au.ru"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.124 Safari/537.36"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Referer", "http://krsk.24au.ru/"
        .setRequestHeader "Accept-Encoding", "gzip , deflate"
        .setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
        .setRequestHeader "Cookie", cookie$
        .send PostData
        
        For Each .getResponseHeader("Set-Cookie") In .getAllResponseHeaders()
        cookie$ = cookie$ + .getResponseHeader("Set-Cookie")
        Next
        
        Location$ = .getResponseHeader("Location") ' при удачной авторизации сайт перенаправляет на указанную страницу
        MsgBox "Location " & Location
       If Not Location$ Like "*http://krsk.24au.ru/*" Then
            MsgBox "Ошибка авторизации на сайте atsenergo.ru", vbCritical, "Обратитесь к разработчику программы"
            Exit Function
        End If
        
        'Идем на Location
        
        .Open "GET", Location$, False
       .setRequestHeader "Host", "krsk.24au.ru"
       .setRequestHeader "Connection", "keep-alive"
       .setRequestHeader "Cache-Control", "max-age=0"
       .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
       .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.124 Safari/537.36"
       .setRequestHeader "Referer", "http://common.24au.ru/login/"
       .setRequestHeader "Accept-Encoding", "gzip , deflate, sdch"
       .setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
       .setRequestHeader "Cookie", cookie$
       .send

        cookie$ = .getResponseHeader("Set-Cookie")
    auth = cookie$
    htmlau = .responseText
    Open "C:\test.txt" For Output As #1

    Print #1, htmlau

    Close #1
   End With
End Function
 
Построение диаграммы с помощью VBA, с формы выбираем столбцы
 
я далеко не программист )) как видно из файла я риэлтор, делаю для себя. Я даже и подумать не мог что файл может что то кому то нарушить, прошу прощения за такое. Наоборот думал что лучше выложить оригинал...а проблемы не относящиеся к вопросу можно не трогать. )))
Построение диаграммы с помощью VBA, с формы выбираем столбцы
 
Ну кто-нибудь, дайте хоть совет
Условное форматирование (очень нужна помощь)
 
Так хотел? Я честно говоря не знаю, как сделать чтобы оно было прям вообще постоянно, как условное форматирование, сделал макросом, обрабатывается по кнопке, с цветами сам играй потом как хочешь
Построение диаграммы с помощью VBA, с формы выбираем столбцы
 
Файл прилагаю.
Что есть:
Таблица, которая со временем будет заполнена количеством продаваемых квартир в городе в целом, и по районам в частности, также средняя цена на данные квартиры (откроете файл - поймете)
Что нужно:
По нажатию кнопки появляется форма, на которой выбираем диапазон дат для построения диаграммы, также есть чекбоксы, которые отвечают за выбор районов и количества комнат. Выбираем нужные районы, нужные квартиры и по нажатию кнопки ОК должно происходить построение диаграммы на отдельном листе.
У меня вся проблема в данный момент как раз с чекбоксами, они не по порядку выбирают столбцы. Даже в голове не могу придумать алгоритм ((( помогите пожалуйста.
Изменено: sinus - 25.09.2014 21:02:49
Ошибка VBA 80004005
 
Спасибо! Понял где ошибка была, создавалось много много процессов ie32.exe
Вобщем прикрепляю файл с рабочим макросом парсинг HTML страницы по заданным исходным данным в столбце, может кому пригодится из таких же нубов как я, переделает под себя. Тему можно переименовать и закрыть
Изменено: sinus - 21.09.2014 08:55:16
Ошибка VBA 80004005
 
Буквально час назад все работало, сейчас вываливается ошибка 80004005, указывает на строку:
Код
Set IE = CreateObject("InternetExplorer.Application")
 
Вот весь код (не смотрите на комментарии, я нуб, шляпал из нескольких похожих макросов) Если что файл в приложении. Надеюсь на вашу помощь
Код
Sub Запуск()    
    Dim myRegExp As New RegExp ' создаём экземпляр RegExp'a
    Dim aMatch As Match ' один из совпавших образцов
    Dim colMatches As MatchCollection ' коллекция этих образцов
    Dim testString As String ' тестируемая строка
    Dim ieDoc As MSHTML.HTMLDocument
    Dim objCollectionIf As Object
    Dim d, lr1&, k&, i&, j&, a()
    
    With Workbooks("Конкуренты.xls").Sheets("Лист1")
    lr1 = .Cells(.Rows.Count, "b").End(xlUp).Row
    a = .Range("B3:B" & lr1 + 2).Value
    
    For i = 1 To UBound(a)
        
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
    IE.Navigate "http://homes.gilcom.ru/view/" & .Cells(i, 2).Value
    While IE.busy Or (IE.readyState <> 4)
        DoEvents
    Wend
    Set ieDoc = IE.Document
    'Debug.Print ieDoc.body.outerHTML
    'ActiveSheet.Cells(1, 3) = ieDoc.body.outerHTML
    testString = ieDoc.body.outerHTML
myRegExp.MultiLine = False ' текст однострочный
myRegExp.Global = True ' будем проходить всю строку
myRegExp.IgnoreCase = True ' игнорируем регистр символов
myRegExp.Pattern = "card__header.(.*)</h2>"
Set colMatches = myRegExp.Execute(testString) ' запускаем!

For Each aMatch In colMatches ' проходим по всей коллекции

Cells(i, 4) = aMatch.SubMatches(0)
 
Next aMatch

myRegExp.Pattern = "card__address.(.*)</p>"
Set colMatches = myRegExp.Execute(testString) ' запускаем!

For Each aMatch In colMatches ' проходим по всей коллекции

Cells(i, 5) = aMatch.SubMatches(0)
 
Next aMatch

myRegExp.Pattern = "card__cost.(.*)</p>"
Set colMatches = myRegExp.Execute(testString) ' запускаем!

For Each aMatch In colMatches ' проходим по всей коллекции

Cells(i, 6) = aMatch.SubMatches(0)
Cells(i, 6).Replace What:="&nbsp;", Replacement:=" "

Next aMatch
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i, 3), _
                               Address:="http://homes.gilcom.ru/view/" & .Cells(i, 2).Value, _
                               TextToDisplay:="Ссылка на жилком"
Next i
End With
End Sub 
Проблемы при разном количестве, помогите исправить код
 
Как всегда поторопился обрадоваться.
Здесь мы суммируем одинаковые группы товара в столбике B словаре ddd.
Код
For i = 1 To UBound(a)
            d.Item(a(i, 3)) = a(i, 1)
            ddd.Item(a(i, 1)) = ddd.Item(a(i, 1))
            ddd.Item(a(i, 1)) = ddd.Item(a(i, 1)) + 1
            
        Next i
 
Но эти подкатегории могут относится к разным категориям (столбик А), и как быть тогда?
Допустим в столбике В - Тостеры , их 10, но 9 из них относятся к группе "Кухонная техника" (столбик А), а один относится к группе "После ремонта"(тоже столбик А), вот как его не учитывать - я не пойму.
Такой код не работает почему то
Код
For i = 1 To UBound(a)
            d.Item(a(i, 3)) = a(i, 1)
            ddd.Item(a(i, 1)) = ddd.Item(a(i, 1))
            ddd.Item(a(i, 1)) = ddd.Item(a(i, 1)) + 1
            If .Cells(i, 1).Value = "После ремонта" Then
            ddd.Item(a(i, 1)) = ddd.Item(a(i, 1)) - 1
            End If
        Next i
 
Подскажите пожалуйста кто не спит )))
Изменено: sinus - 18.03.2014 21:32:50
Проблемы при разном количестве, помогите исправить код
 
Йес, опытным путем сделал все-таки...спасибо Hugo!!!!!, вот код который мне нужен:
Код
Sub test()
    Dim d As Object, dd As Object, lr&, z&, zz&, k&, kk&, i&, a()

    Set d = CreateObject("scripting.dictionary")
    Set dd = CreateObject("scripting.dictionary")
    Set ddd = CreateObject("scripting.dictionary")
    With Workbooks("price.xls").Sheets(1)
        lr = .Cells(.Rows.Count, "a").End(xlUp).Row
        a = .Range("B2:D" & lr).Value

        For i = 1 To UBound(a)
            d.Item(a(i, 3)) = a(i, 1)
            ddd.Item(a(i, 1)) = ddd.Item(a(i, 1)) + 1
        Next i
            z = ddd.Item("Блендеры")
            zz = ddd.Item("Тостеры")
    End With

    With Workbooks("nabor.xls").Sheets(1)
        lr = .Cells(.Rows.Count, "a").End(xlUp).Row
        a = .Range(.[a1], .Cells(lr, "a")).Value
        For i = 1 To UBound(a)
            If d.exists(a(i, 1)) Then dd.Item(d.Item(a(i, 1))) = dd.Item(d.Item(a(i, 1))) + 1
        Next
        
    End With
    k = dd.Item("Блендеры")
    kk = dd.Item("Тостеры")
    
        MsgBox ("на складе Блендеров" & z & " , свободных " & k)
        MsgBox ("на складе Тостеров" & zz & " , свободных " & kk)
   

End Sub
 
Проблемы при разном количестве, помогите исправить код
 
Цитата
Hugo пишет:
Если нужно посчитать сколько всего - зачем вообще нужен файл nabor.xls?
Если нужно посчитать параллельно - добавьте ещё один словарь, куда при первом переборе и считайте повторы.
Ога, все так просто...повторюсь, считаем группу "Блендеры" в файле price.xls (ну нужно мне это число, нужно), как и нужно знать сколько из списка артикулов (файл nabor.xls) входит в группу "Блендеры" ))  и так по группам дальше.
Мне нужно вынести их в 2 переменных, потому что есть третий файл куда они будут забиваться.
Вот сколько всего блендеров мы получили:
Код
For i = 1 To UBound(a)
            d.Item(a(i, 3)) = a(i, 1)
            ddd.Item(a(i, 1)) = ddd.Item(a(i, 1)) + 1
        Next i
            z = ddd.Item("Блендеры")
 
А вот как получить в одну переменную сколько блендеров в списке nabor.xls я не пойму
Код
For i = 1 To UBound(a)
            If d.exists(a(i, 1)) Then dd.Item(d.Item(a(i, 1))) = dd.Item(d.Item(a(i, 1))) + 1
        Next
        
    End With

    For Each k In dd.keys
        MsgBox ("на складе " & k & " , свободных " & dd.Item(k))
    Next
 
Здесь k это как бы общая переменная для всех повторяющихся групп, а вот отдельно...
Изменено: sinus - 18.03.2014 20:07:59
Проблемы при разном количестве, помогите исправить код
 
Цитата
Hugo пишет:
Чего всего? У меня считает Блендеры, Тостеры и даже Тостеры-тест для теста.
У меня в сообщении пишет "На складе Блендеры, свободных 8", после как жмешь ОК, "На складе тостеры, свободных 4"
То есть не считает сколько всего блендеров в файле price....или я не то делаю?
Сейчас как бы работает наполовину но с другой стороны ))) а объединить не могу в единое  
Изменено: sinus - 18.03.2014 19:58:37
Проблемы при разном количестве, помогите исправить код
 
не считает сколько всего, из файла price
попробовал так, ну и как всегда у меня, не понимаю логику...
охото мухи от дельно, котлеты отдельно...не получается
Код
Sub aaddddw()
    Dim d As Object, dd As Object, lr&, z&, k, i&, a()

    Set d = CreateObject("scripting.dictionary")
    Set dd = CreateObject("scripting.dictionary")
    Set ddd = CreateObject("scripting.dictionary")
    With Workbooks("price.xls").Sheets(1)
        lr = .Cells(.Rows.Count, "a").End(xlUp).Row
        a = .Range("B2:D" & lr).Value

        For i = 1 To UBound(a)
            d.Item(a(i, 3)) = a(i, 1)
            ddd.Item(a(i, 1)) = ddd.Item(a(i, 1)) + 1
        Next i
            z = ddd.Item("Блендеры")
    End With

    With Workbooks("nabor.xls").Sheets(1)
        lr = .Cells(.Rows.Count, "a").End(xlUp).Row
        a = .Range(.[a1], .Cells(lr, "a")).Value
        For i = 1 To UBound(a)
            If d.exists(a(i, 1)) Then dd.Item(d.Item(a(i, 1))) = dd.Item(d.Item(a(i, 1))) + 1
        Next
        
    End With

    For Each k In dd.keys("Блендеры")
        MsgBox ("на складе " & z & " , свободных " & dd.Item(k))
    Next

End Sub
 
Изменено: sinus - 18.03.2014 19:51:24
Проблемы при разном количестве, помогите исправить код
 
Цитата
Hugo пишет:
Я думаю тут нужно с другой стороны подойти:
Спасибо! я сейчас пока в код "повъезжаю", не могу сообразить
Не понимаю почему так, не понимаю как со словарями работать. И он не считает сколько всего
Изменено: sinus - 18.03.2014 19:43:21
Проблемы при разном количестве, помогите исправить код
 
В прайсе товар с группами в В столбике и с артикулами в D. (мы и занимались тем что считали сколько наименований товара в определенной группе).
В наборе (второй файл), просто перечисление артикулов. Нужно посчитать сколько артикулов относится к одной группе, сколько ко второй. Вот сложность

Код
lr2 = .Cells(.Rows.Count, "a").End(xlUp).Row
      b = .Range(.[a1], .Cells(lr2, "a")).Value
      sr = 0
      For i = 1 To UBound(b)
       If dd.Items(b(i, 1)) = dd.Items("Блендеры") Then sr = sr + 1 
     Next
Вот что в голову пришло...
Полный код

Код
Sub test()
  
Dim d, dd, lr1&,  lr1&, k&, i&, j&, a(), ke() 
With Workbooks("price.xls").Sheets(1) 
Set d = CreateObject("scripting.dictionary")  
 Set dd = CreateObject("scripting.dictionary")
        lr1 = .Cells(.Rows.Count, "a").End(xlUp).Row
        a = .Range("B2:D" & lr1).Value

        For i = 1 To UBound(a)
            d.Item(a(i, 1)) = a(i, 3)
            dd.Item(a(i, 1)) = dd.Item(a(i, 1)) + 1  
        Next i

        k = dd.Item("мониторы LCD")
        End With
    With Workbooks("for comparison.xls").Sheets(1)
      lr2 = .Cells(.Rows.Count, "a").End(xlUp).Row
      b = .Range(.[a1], .Cells(lr2, "a")).Value
      j = 0
      For i = 1 To UBound(b)
       If dd.Items(b(i, 1)) = dd.Items("мониторы LCD") Then j = j + 1
       
      Next
    End With  
MsgBox ("на складе " k " мониторов, свободных " j )
End With
End Sub 
Нет, не работает (((
Изменено: sinus - 18.03.2014 19:09:41
Проблемы при разном количестве, помогите исправить код
 
Теперь проблема серьезней (((  в другом файле просто набор артикулов (массив b) которые есть в виде значений в словаре d. Раньше то я автофильтром выделял группу и загонял в словарь и по нему сверял сколько совпадений из второго файла и получал переменную sr, а как делать сейчас?
Так было:
Код
With Workbooks("for comparison.xls").Sheets(1)
      lr2 = .Cells(.Rows.Count, "a").End(xlUp).Row
      b = .Range(.[a1], .Cells(lr2, "a")).Value
      sr = 0
      For i = 1 To UBound(b)
       If d.exists(b(i, 1)) Then sr = sr + 1
      Next
    End With
 
А сейчас я даже корявый свой код представить не могу.
Надо вытащить массив значений с ключа "Хлебопечи" и с ним оперировать? сравнивать?
Изменено: sinus - 18.03.2014 18:32:12
Проблемы при разном количестве, помогите исправить код
 
Hugo спасибо большое за то что не бросаете одинокого неуча )))
я уже просто ненавижу хлебопечки млин ))))
Но все таки непонятно почему мой код неправилен? что бы я знал косяки и не делал так больше
Изменено: sinus - 18.03.2014 20:43:09
Страницы: 1 2 След.
Наверх