Новости:

Интересные и полезные статьи по работе с Excel и VBA
можно найти в разделе ХИТРОСТИ

Главное меню

Ошибка при сравнении диапазонов

Автор Elena666, 04.06.2015, 14:10:05

« назад - далее »

Elena666

Здравствуйте,

проблема в следующем:
пытаюсь сравнить два диапазона на Листе1 "Общий" диапазон B4:B6 и Листе18 "ОК" диапазон A1:A3. Соответственно, при равенстве - происходит заливка диапазона B4:B6 на Листе1.
Данные для Листа 1 в ячейках B4:B6  формируются формулами. Данные на лист 18"ОК" в диапазон A1:A3 вносятся через юзерформу. If Evaluate("AND(" & Sheets("Общий").Name & "!B4:B6=" & Sheets(2).Name & "!A1:A3)") Then Sheets("Общий").Range("B4:B6").Interior.ColorIndex = 4
Но возникает ошибка:
Run-time error 13
Tipe mismatch

И до слова "then" выделяет желтым

Может тут проблема с названием листов или с порядком страниц в книге? Подскажите, пожалуйста, как можно исправить.

Elena666

Пример в приложении. Спасибо.

Дмитрий Щербаков(The_Prist)

Вообще в приложенном примере ошибка не повторяется. Но и сравнения не будет, т.к. в принципе не очень правильно так сравнивать. Лучше сделать отдельную функцию сравнения:
Sub IsRangesEqual()
 If CompRanges(Sheets("Общий").Range("B4:B6"), Sheets(8 ).Range("A1:A3")) Then
   Sheets("Общий").Range("B4:B6").Interior.ColorIndex = 4
 End If
End Sub

Function CompRanges(r1 As Range, r2 As Range) As Boolean
   If r1.Count <> r2.Count Then
       Exit Function
   End If
   Dim a1, a2, lr As Long, lc As Long
   a1 = r1.Value
   If Not IsArray(a1) Then ReDim a1(1 To 1, 1 To 1): a1(1, 1) = r1.Value
   a2 = r2.Value
   If Not IsArray(a2) Then ReDim a2(1 To 1, 1 To 1): a2(1, 1) = r2.Value
   
   For lr = 1 To UBound(a1, 1)
       For lc = 1 To UBound(a1, 2)
           If a1(lr, lc) <> a2(lr, lc) Then
           'если тип данных не играет роли, то более сравнение можно проводить по строке
           'в примере на листе Общий в В4 - дата, а на листе "NOK2" текст в виде даты - "17.05.2015"
           'такие данные не будут равны
           'If CStr(a1(lr, lc)) <> CStr(a2(lr, lc)) Then
               Exit Function
           End If
       Next lc
   Next lr
   CompRanges = True
End Function
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

Elena666

Спасибо огромное, The_Prist,  все заработало.

Яндекс.Метрика Рейтинг@Mail.ru