ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Необходимо сравнить два списка со значениями
6 сообщений из 6, страница 1 из 1
Необходимо сравнить два списка со значениями
    #34371683
pitdoc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
pitdoc
Гость
Необходимо сравнить два списка со значениями на предмет изменения значения для определённого поля
т.е. есть две таблицы, одна из которых будет каждый день изменяться
Пример:
таблица1
ID Описание отдел
1 Desc1 отдел1
2 Desc2 отдел2
3 Desc3 отдел3
4 Desc4 отдел4


таблица2(будет меняться каждый день)

ID Описание отдел
1 Desc1 отдел1
2 Desc2 отдел2
3 Desc3 отдел1
4 Desc4 отдел3

необходимо написать макрос который будет проверять изменения отделов для определённых ID, т.е.
если в первой таблице для ID3 соответствует отдел3, а во второй таблице отдел1, то необходимо проставлять правильный отдел (отдел1) в первой таблице рядом с неправильным (отдел3)

Я попытался написать макрос, но что то не очень выходить(((
Если не трудно, гуру посмотрите что не так. Я ещё новичок в макросо строении, но буду стараться )))

Код: 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.
Sub comparisontables()

Dim CorrectOtdelsheet1( 1000 ) as Double
Dim CorrectOtdelsheet2( 1000 ) as Double
CorrectOtdelsheet1( 1 ) =  0 
CorrectOtdelsheet2( 1 ) =  0 
    
    j =  2 
    i =  2 
    ActiveWorkbook.Worksheets("sheet1").Range("A2:C1000").Sort (Cells( 2 ,  1 ))
    While (ActiveWorkbook.Worksheets("sheet1").Cells(i,  1 ) <> "")
    
    If (ActiveWorkbook.Worksheets("sheet1").Cells(i,  1 ) = ActiveWorkbook.Worksheets("sheet2").Cells(j,  1 )) Then
    If (ActiveWorkbook.Worksheets("sheet1").Cells(i,  3 ) = ActiveWorkbook.Worksheets("sheet2").Cells(j,  3 )) Then
        CorrectOtdelsheet1(i) = CorrectOtdelsheet1(i) + Range("C" + Format(Row)).Value
    ElseIf (ActiveWorkbook.Worksheets("sheet1").Cells(i,  3 ) <> ActiveWorkbook.Worksheets("sheet2").Cells(j,  3 )) Then
        CorrectOtdelsheet2(i) = CorrectOtdelsheet2(i) + ActiveWorkbook.Worksheets("sheet2").Range("C"+Format(Row)).Value
        
        End If
        i = i +  1 
    End If
        j = j +  1 
    Wend
    ActiveWorkbook.Worksheets("Report").Range("A6:G1000").Sort (Cells( 2 ,  1 ))

       'отображение полученных результатов на странице sheet1
       
       ActiveWorkbook.Worksheets("sheet1").Select
    RowFrom =  1 
    For i =  1  To i
    Range ("D" + Format(RowFrom)) = CorrectOtdelsheet1(i) 
  
    Rowfrom = Rowfrom +  1 
    Next i

End Sub
...
Рейтинг: 0 / 0
05.03.2007, 15:19:27
| Ответить | Цитировать | Написать  
Необходимо сравнить два списка со значениями
    #34371811
vbapro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vbapro
Участник
а не хочешь воспользоваться функцией листа ВПР (VLOOKUP)?
...
Рейтинг: 0 / 0
05.03.2007, 15:58:00
| Ответить | Цитировать | Написать  
Необходимо сравнить два списка со значениями
    #34371827
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
1-е: Почему Double
Код: plaintext
Dim CorrectOtdelsheet1( 1000 ) As Double
2-е: Зачем к старому значению прибавлять новое, если старое = 0
Код: plaintext
CorrectOtdelsheet1(i) = CorrectOtdelsheet1(i) + Range("C" + Format(Row)).Value
3-е: Где определяется переменная "Row"
Код: plaintext
Range("C" + Format(Row)).Value
4-е: Ты уверен что, количество ID в первой таблице всегда совпадает с количеством ID в второй таблицы, и небывает например такого
ID таблицы1 = 1,2,4,5
ID таблицы2 = 1,3,4,5
(только если нет таких анамалий, можно использовать выбранный тобой алгоритм)
осмелюсь предложить такой вариант

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Sub comparisontables2()
Dim rng As Range
    i =  2 
    With ActiveWorkbook.Worksheets("sheet1")
        .Range("A2:C1000").Sort (.Cells( 2 ,  1 ))
    
        While (.Cells(i,  1 ) <> "")
            Set rng = ActiveWorkbook.Worksheets("sheet2").Range("A:A").Find( _
                What:=.Cells(i,  1 ), LookIn:=xlValues, LookAt:= _
                xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
            If Not rng Is Nothing Then
                    If (.Cells(i,  3 ) <> rng.Offset( 0 ,  2 )) Then _
                        .Cells(i,  3 ).Value = rng.Offset( 0 ,  2 ).Value
            Else
                .Cells(i,  4 ) = "Не найден ID"
            End If
            i = i +  1 
        Wend
    End With

End Sub
...
Рейтинг: 0 / 0
05.03.2007, 16:02:55
| Ответить | Цитировать | Написать  
Необходимо сравнить два списка со значениями
    #34373345
pitdoc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
pitdoc
Гость
vkodor, спасибо огромное за помощь и за указания ошибок в моём коде
попробовал я твой вариант
впринципе всё работает, но есть некоторые трудности
например: если в первой таблице есть ID которого нет во второй таблице то появляется ошибка
для большей наглядности прикрепляю файл с кодом
заранее спасибо
...
Рейтинг: 0 / 0
06.03.2007, 10:08:53
| Ответить | Цитировать | Написать  
Необходимо сравнить два списка со значениями
    #34374062
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
pitdocvkodor, спасибо огромное за помощь и за указания ошибок в моём коде
попробовал я твой вариант
впринципе всё работает, но есть некоторые трудности
например: если в первой таблице есть ID которого нет во второй таблице то появляется ошибка
для большей наглядности прикрепляю файл с кодом
заранее спасибо

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
Sub comparisontables2()
    Dim rng As Range
    Dim tabl1 As String, tabl2 As String
    tabl1 = "sheet2"
    tabl2 = "sheet1"
    i =  2 
    With ActiveWorkbook.Worksheets(tabl1)
        .Range("A2:C1000").Sort .Cells( 2 ,  1 )
        While .Cells(i,  1 ) <> ""
            Set rng = ActiveWorkbook.Worksheets(tabl2).Range("A:A").Find(.Cells(i,  1 ), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
            If Not rng Is Nothing Then
                If .Cells(i,  3 ) <> rng.Offset( 0 ,  2 ) Then
                    .Cells(i,  3 ).Value = rng.Offset( 0 ,  2 ).Value
                End If
            Else
                MsgBox "Не найден ID " & .Cells(i,  1 )
            End If
            i = i +  1 
        Wend
    End With

End Sub

End Sub
...
Рейтинг: 0 / 0
06.03.2007, 12:40:36
| Ответить | Цитировать | Написать  
Необходимо сравнить два списка со значениями
    #34374160
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Джон УокенбахКонструкция With-End With

Конструкция With-End With позволяет выполнять несколько операций над одним объектом. Чтобы понять, как она работает, проанализируйте следующую процедуру, которая изменяет пять свойств выделенного объекта (подразумевается, что выделен объект Range)
Код: plaintext
1.
2.
3.
4.
5.
6.
Sub CangeFontl()
     Selection.Font.Name =   "Times New Roman" 
     Selection.Font.FontStyle =   "Bold Italic" 
     Selection.Font.Size  =  12       
     Selection.Font.Underline =xlUnderlinestyleSingle
     Selection.Font.ColorIndex =  5  
End Sub
Эту процедуру можно переписать с помощью конструкции With-End With. Процедура показанная ниже, работает точно так же, как и предыдущая:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
Sub ChangeFont2()
With Selection.Font	
     .Name  =  "Times New Roman"	
     .FontStyle = "Bold Italic" 
     .Size  =   12 
     .Underline = xlUnderlineStyleSingle 
     .ColorIndex =  5  
End With
End Sub
Некоторые считают, что второй вариант этой процедуры читать сложнее. Однако помните, что целью изменений является увеличение скорости выполнения операций. Первый вариант более прямолинейный и его легче понять, но процедура, использующая для нескольких свойств одного объекта конструкцию With-End With, помогает повысить эффективность выполнения кода по сравнению с эквивалентной ей процедурой, которая явно ссылается на объект в каждом операторе.
...
Рейтинг: 0 / 0
06.03.2007, 13:02:13
| Ответить | Цитировать | Написать  
6 сообщений из 6, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Необходимо сравнить два списка со значениями
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=34371683&tid=2183340]:
 0ms
get settings:
 8ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 66ms
get topic data:
 6ms
get forum data:
 1ms
get page messages:
 26ms
get tp. blocked users:
 1ms
others: 220ms
total:  348ms
созд. / загр.: 348ms
x
x
Закрыть


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