ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите переделать макрос
8 сообщений из 8, страница 1 из 1
Помогите переделать макрос
    #35162965
GeorgP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
GeorgP
Гость
Есть макрос, который ищет совпадающие значения по столбцам в EXEL на листе "Заказ" и "Приход" и копирует совпадения на лист "Результат"... Суть вопроса: как оптимизировать макрос, чтобы если на листе "Приход" значение из первого столбца повторяется снова, в результате происходило суммирование значения из второго столбца напротив найденного с предыдущим. Если значение не найдено на листе "Приход", то вывод сообщения об этом.
Для наглядности примера PrintScreen таблиц прилагается.

Sub Analiz()
Dim iLastRowSht2 As Long
Dim iValue As String
Dim iFind As Range
Dim i As Long, n As Long
iLastRowSht2 = Sheets("Приход").Range("A65536").End(xlUp).Row
n = 1
For i = 2 To iLastRowSht2
iValue = Sheets("Приход").Cells(i, 1)
Set iFind = Sheets("Заказ").Columns(1).Find(What:=iValue, LookAt:=xlWhole)
If Not iFind Is Nothing Then
n = n + 1
Sheets("Приход").Cells(i, 1).EntireRow.Copy Destination:=Sheets("Результат").Cells(n, 1)
End If
Next
MsgBox "Смотри РЕЗУЛЬТАТ", vbInformation, "Анализ"
End Sub
Заранее спасибо!
...
Рейтинг: 0 / 0
29.02.2008, 12:44:19
| Ответить | Цитировать | Написать  
Помогите переделать макрос
    #35163039
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
А сводная таблица не подойдет?
Обязательно макрос?
...
Рейтинг: 0 / 0
29.02.2008, 13:04:23
| Ответить | Цитировать | Написать  
Помогите переделать макрос
    #35163069
GeorgP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
GeorgP
Гость
Какими средствами это организовать не важно... Может подойдет и сводная таблица. Можно поподробнее об этом методе?
...
Рейтинг: 0 / 0
29.02.2008, 13:13:17
| Ответить | Цитировать | Написать  
Помогите переделать макрос
    #35163192
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
Sub Analiz()
    Dim iLastRowSht2!, i!
    Dim xlShZakaz As Worksheet, xlShPrihod As Worksheet, xlShRes As Worksheet
    Dim rngZakaz As Range, iFindPrihod As Range, iFindRes As Range
    Set xlShZakaz = ThisWorkbook.Sheets("Заказ")
    Set xlShPrihod = ThisWorkbook.Sheets("Приход")
    Set xlShRes = ThisWorkbook.Worksheets.Add(After:=xlShPrihod)
    i =  1 
    Do
        On Error Resume Next
        xlShRes.Name = "Результат" & i
        i = i +  1 
    Loop Until Err.Number =  0 
    xlShRes.Cells( 1 ,  1 ) = "Номер"
    xlShRes.Cells( 1 ,  2 ) = "Кол-во"
    iLastRowSht2 = xlShZakaz.Range("A65536").End(xlUp).Row
    For i =  2  To iLastRowSht2
        Set rngZakaz = xlShZakaz.Cells(i,  1 )
        Set iFindPrihod = xlShPrihod.Columns( 1 ).Find(What:=rngZakaz, LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
        If Not iFindPrihod Is Nothing Then
            Set iFindRes = xlShRes.Columns( 1 ).Find(What:=rngZakaz, LookIn:=xlValues, LookAt:= _
                xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
            If Not iFindRes Is Nothing Then
                iFindRes.Offset( 0 ,  1 ) = iFindRes.Offset( 0 ,  1 ) + rngZakaz.Offset( 0 ,  1 )
            Else
                xlShRes.Cells(xlShRes.Range("A65536").End(xlUp).Row +  1 ,  1 ) = rngZakaz
                xlShRes.Cells(xlShRes.Range("A65536").End(xlUp).Row,  2 ) = rngZakaz.Offset( 0 ,  1 )
            End If
        Else
            xlShRes.Cells(xlShRes.Range("A65536").End(xlUp).Row +  1 ,  1 ) = rngZakaz
            xlShRes.Cells(xlShRes.Range("A65536").End(xlUp).Row,  2 ) = "Нет"
        End If
    Next
        xlShRes.Columns("A:B").Sort Key1:=xlShRes.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:= 1 , MatchCase:=False, Orientation:=xlTopToBottom

    MsgBox "Смотри лист " & xlShRes.Name, vbInformation, "Анализ"
End Sub
...
Рейтинг: 0 / 0
29.02.2008, 13:40:28
| Ответить | Цитировать | Написать  
Помогите переделать макрос
    #35163223
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
А можно на листе "Заказ" прописать такую формулу
Код: plaintext
=ЕСЛИ(СУММЕСЛИ(Приход!A:B;A2;Приход!B:B)= 0 ;"нет";СУММЕСЛИ(Приход!A:B;A2;Приход!B:B))
...
Рейтинг: 0 / 0
29.02.2008, 13:48:55
| Ответить | Цитировать | Написать  
Помогите переделать макрос
    #35163283
GeorgP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
GeorgP
Гость
Спасибо, все почти работает... Только вот разница в кол-ве на этих листах не учитывается... Нужно, чтобы из кол-ва на листе "заказ" вычиталось кол-во на листе приход... Попробую разобраться к коде...
...
Рейтинг: 0 / 0
29.02.2008, 14:03:36
| Ответить | Цитировать | Написать  
Помогите переделать макрос
    #35163304
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
Sub Analizd()
    Dim iLastRowSht2!, i!
    Dim xlShZakaz As Worksheet, xlShPrihod As Worksheet, xlShRes As Worksheet, rngZakaz As Range
    Set xlShZakaz = ThisWorkbook.Sheets("Заказ")
    Set xlShPrihod = ThisWorkbook.Sheets("Приход")
    Set xlShRes = ThisWorkbook.Worksheets.Add(After:=xlShPrihod)
    i =  1 
    Do
        On Error Resume Next
        xlShRes.Name = "Результат" & i
        i = i +  1 
    Loop Until Err.Number =  0 
    xlShRes.Cells( 1 ,  1 ) = "Номер"
    xlShRes.Cells( 1 ,  2 ) = "Кол-во"
    iLastRowSht2 = xlShZakaz.Range("A65536").End(xlUp).Row
    For i =  2  To iLastRowSht2
        Set rngZakaz = xlShZakaz.Cells(i,  1 )
        xlShRes.Cells(i,  1 ) = rngZakaz
        xlShRes.Cells(i,  2 ) = IIf(WorksheetFunction.SumIf(xlShPrihod.Columns("A:B"), _
            rngZakaz, xlShPrihod.Columns("B:B")) =  0 , "нет", _
            rngZakaz.Offset( 0 ,  1 ) - WorksheetFunction.SumIf(xlShPrihod.Columns("A:B"), rngZakaz, xlShPrihod.Columns("B:B")))
    Next
    xlShRes.Columns("A:B").Sort Key1:=xlShRes.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:= 1 , MatchCase:=False, Orientation:=xlTopToBottom

    MsgBox "Смотри лист " & xlShRes.Name, vbInformation, "Анализ"
End Sub
...
Рейтинг: 0 / 0
29.02.2008, 14:11:07
| Ответить | Цитировать | Написать  
Помогите переделать макрос
    #35163322
GeorgP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
GeorgP
Гость
Огромное спасибо! Все работает так как и хотелось!
А то запарно было вручную заказы с приходами сверять...
...
Рейтинг: 0 / 0
29.02.2008, 14:16:07
| Ответить | Цитировать | Написать  
8 сообщений из 8, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите переделать макрос
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&fpage=242&tid=2181340]:
 0ms
get settings:
 5ms
get forum list:
 12ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 29ms
get topic data:
 7ms
get forum data:
 2ms
get page messages:
 34ms
get tp. blocked users:
 1ms
others: 204ms
total:  298ms
созд. / загр.: 298ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]