Помогите пожалуйста!!!

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
antony
Сообщения: 2
Зарегистрирован: 04 дек 2009, 08:01

есть две книги Отчет и Реестр
нужно чтобы в книге ОТЧЕТ при нахождении в ячейке словосочетания счет-фактура из этой ячейки выделялся номер без аббревиатуры ( "Счет-фактура №К-К-001821 от 13.05.09" выделялось "К-К-001821" ) для поиска этого номера в книге Реестр. При нахождении соответствия, из книги Отчет берется значение ячейки в столбце С ("Оборот" ) для данного счета и копируется в книгу Реестр столбец J (в ту же строку что и найденная ячейка ) в ячейку той же строки соответствующей № счета который мы ищем.
при не нахождении соответствия искомая ячейка помечается каким либо цветом

помогите пожалуйста
отблагодарю как смогу, веб мани, правда, нет но я что то обязательно придумаю
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
МДА ПО ХОДУ НМКОМУ ЛИБО НЕ ИНТЕРЕСНО ЛИБО ПРОСТО НЕ НУЖНО ЭТО
ХОТЯ И НА ТОМ СПАСИБО!
Вложения
Реестр.zip
(26.66 КБ) 45 скачиваний
Отчет.zip
(12.06 КБ) 50 скачиваний
Teslenko_EA
Сообщения: 526
Зарегистрирован: 04 фев 2007, 18:37
Откуда: Сургут
Контактная информация:

Здравствуйте antony.
Откройте оба документа и выполните следующий код:

Код: Выделить всё

Sub fromRepToReestr()
Dim o1 As Object, o2  As Object, i&, rng As Range, vArr() As Variant, v
Set o1 = Workbooks("Отчет.xls").Sheets(1)
Set o2 = Workbooks("Реестр.xls").Sheets(1)
With o2.UsedRange: i = .Rows.Count + .Row - 1: End With
Set rng = o2.Range("d2:d" & i): vArr = rng.Value
With o1.UsedRange: i = .Rows.Count + .Row - 1: End With
Set rng = o1.Range("a2:a" & i)
For j = 1 To UBound(vArr)
'если имеющиеся данные сохранять нет необходимости
'строки помеченые * можно удалить
    If Not Len(o2.Cells(j + 1, 10)) = 0 Then '*
        vArr(j, 1) = o2.Cells(j + 1, 10) '*
    Else '*
        Set v = rng.Find(vArr(j, 1), LookIn:=xlFormulas)
        vArr(j, 1) = Empty
        If Not v Is Nothing Then
            i = v.Row: vArr(j, 1) = o1.Cells(i, 3)
        End If
    End If '*
Next
o2.Range("j2:j" & UBound(vArr) + 1).Value = vArr
End Sub
"МДА ПО ХОДУ НМКОМУ....", если Вы надеялись, что форум это "машина для ответов" - зря, участники форума люди и у них нет заготовок ответов на все вопросы. :rolleyes:
Евгений.
antony
Сообщения: 2
Зарегистрирован: 04 дек 2009, 08:01

огромное спасибо
как я могу отблагодарить?

но можно ли было бы расписать ремарками основные действия - т.е. где происходит поиск соответствующих ячеек и т.д. ... как допустим в книге РЕЕстр изменить столбец не J, а K ?

когда-то давно в 1996-7 годах я писал на бейсеке но это был еще компутер "правец" ....
с тех пор многое поменялось вот и хотел бы поднатареть в этом деле много бумажной волокиты просто на работе... хотел бы поупрощать
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
ваш код работает огромное спасибо!

я сохранил его в надстройку сделал кнопочку

только при компиляции выдает ошибку вроде все правильно сделал
не поможете начинающему?


да и как мне вас отблагодарить вы с Украины?
Вложения
Реестр.zip
(41.99 КБ) 49 скачиваний
Teslenko_EA
Сообщения: 526
Зарегистрирован: 04 фев 2007, 18:37
Откуда: Сургут
Контактная информация:

Здравствуйте antony.
"при компиляции выдает ошибку..." - на какую строку указывает ошибка?
Код вполне работоспособный, возможно только отсутствие обработчика ошибок при выполнении проявляется? В любом случае подобная корректировка не навредит:

Код: Выделить всё

Sub fromRepToReestr()
On Error GoTo 9
Err.Clear
...
...
9
' If Not Err.Number = 0 Then MsgBox Err.Description: Err.Clear
End Sub
Евгений.
P.S. у Вас новое сообщение.
Ответить