Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Необходимо сравнить два списка со значениями / 6 сообщений из 6, страница 1 из 1
05.03.2007, 15:19:27
    #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:58:00
    #34371811
vbapro
vbapro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Необходимо сравнить два списка со значениями
а не хочешь воспользоваться функцией листа ВПР (VLOOKUP)?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.03.2007, 16:02:55
    #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
| Ответить | Цитировать | Написать  
06.03.2007, 10:08:53
    #34373345
pitdoc
pitdoc
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Необходимо сравнить два списка со значениями
vkodor, спасибо огромное за помощь и за указания ошибок в моём коде
попробовал я твой вариант
впринципе всё работает, но есть некоторые трудности
например: если в первой таблице есть ID которого нет во второй таблице то появляется ошибка
для большей наглядности прикрепляю файл с кодом
заранее спасибо
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.03.2007, 12:40:36
    #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, 13:02:13
    #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
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Необходимо сравнить два списка со значениями / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 349ms
Закрыть
start [/forum/topic.php?fid=61&mobile=1&tid=2183340]:
 0ms
get settings:
 6ms
get forum list:
 14ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 51ms
get topic data:
 8ms
get forum data:
 2ms
get page messages:
 37ms
get tp. blocked users:
 2ms
others: 225ms
total:  349ms
x
x
Закрыть


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