Точнее, совпадение будет меньше либо равно одному.

Здравствуйте. Необходимо реализовать следующую процедуру: сравнить строковые значения столбца Х в книге А со строковым столбцом У книги В. При наличии совпадений в соседний Х столбец книги А занести значение числового соседнего столбца У книги В. Совпадение для каждой ячейки столбца Х в У гарантированно будет только одно.  
Подскажите, пожалуйста, как это сделать! Желательно, чтобы выполнение процедуры было возможно при закрытой книге В.  
И еще вопрос: как сделать макрос доступным во всех книгах Excel на моем компьютере?  
Заранее спасибо.

Вышла из положения следующим образом:  
  Cells(i, y + 3).Formula = "=RC[-2]+RC[-1]"
  Cells(i, y + 5).Formula = "=RC[-1]+RC[-2]"
Однако решение проблемы способом VBA, а не Excel, меня по-прежнему интересует.

Параметры DateAdd(Interval,Number, DateValue)  
 
Interval    
 
Необходимо. Значение перечисления DateInterval или выражение типа String, представляющее добавляемый период времени.  
 
Number    
 
Обязателен. Double. Выражение с плавающей запятой, представляющее количество добавляемых интервалов времени. Параметр Number может иметь как положительное (для получения значений даты и времени в будущем), так и отрицательное значение (для получения значений даты и времени в прошлом). Дробная часть Number не учитывается.  
 
DateValue    
 
Обязателен. Date. Выражение, представляющее дату и время, к которым добавляется интервал. Само значение DateValue в вызывающей программе не изменяется.  
 
y - День года; отбрасывается дробная часть, остается целое значение

Так как в качестве параметра количества дней DateAdd принимает переменную типа Double, попробовала вот так развернуть строку сложения:  
Dim A As Double  
Dim D As Date  
Dim D1 As Date  
 
A = Cells(i, y + 2).Value  
   D = Cells(i, y + 1).Value  
   D1 = DateAdd(y, A, D)  
   Cells(i, y + 3).Value = D1  
 
Результат тот же

При выполнении данной процедуры возникает ошибка "Type mistmatch". Подскажите, пожалуйста, в чем дело.  
 
Sub Макрос3()  
Dim i As Integer  
Dim j As Integer  
Dim x As Integer  
Dim y As Integer  
Dim A As Double  
Dim B As Double  
 
x = ActiveCell.Row  
y = ActiveCell.Column  
i = x  
Do While ((ColorIndex(Cells(i, y))) <> 21)  
   Cells(i, y + 1).Formula = "=MID(RC[-1],SEARCH(""??.??.????"",RC[-1],1),10)"
   Cells(i, y + 1).NumberFormat = "m/d/yyyy"  
   Cells(i, y + 2).NumberFormat = "0"  
   Cells(i, y + 3).NumberFormat = "m/d/yyyy"  
   Cells(i, y + 4).NumberFormat = "m/d/yyyy"  
   Cells(i, y + 4).Formula = "=TODAY()"  
   Cells(i, y + 5).NumberFormat = "0"  
   Cells(i, y + 2).Value = 30  
   Cells(i, y + 3).Value = DateAdd(y, Cells(i, y + 2).Value, Cells(i, y + 1).Value)  
   Cells(i, y + 5).Value = Cells(i, y + 4).Value - Cells(i, y + 3).Value  
   i = i + 1  
Loop

Спасибо!

Включив мозг, добавила End if'ы везде, но это, конечно же, не помогло: ошибка возникает раньше.

Здравствуйте. Наверное, напутала что-то с типами данных.. При выполнении данного макроса возникает ошибка "Else without if" :  
 
Sub Macros()  
Dim i As Integer  
Dim j As Integer  
Dim x As Integer  
Dim y As Integer  
Dim A As Double  
 
x = ActiveCell.Row  
y = ActiveCell.Column  
i = x  
 
Do While ((ColorIndex(Cells(i, y))) <> 21)  
   Cells(i, y + 6).Value = Cells(i, y + 1).Value  
   Cells(i, y + 1).Formula = "=MID(RC[-1],SEARCH(""??.??.????"",RC[-1],1),10)"
   Cells(i, y + 1).NumberFormat = "m/d/yyyy"  
   Cells(i, y + 2).NumberFormat = "0"  
   Cells(i, y + 3).NumberFormat = "m/d/yyyy"  
   Cells(i, y + 3).Value = Cells(i, y + 1).Value + Cells(i, y + 2).Value  
   Cells(i, y + 4).NumberFormat = "m/d/yyyy"  
   Cells(i, y + 4).Formula = "=TODAY()"  
   Cells(i, y + 5).NumberFormat = "0"  
   Cells(i, y + 6).NumberFormat = "#,##0.00"  
   Cells(i, y + 7).NumberFormat = "#,##0.00"  
   Cells(i, y + 8).NumberFormat = "#,##0.00"  
   Cells(i, y + 9).NumberFormat = "#,##0.00"  
   Cells(i, y + 10).NumberFormat = "#,##0.00"  
   Cells(i, y + 11).NumberFormat = "#,##0.00"  
   Cells(i, y + 12).NumberFormat = "#,##0.00"  
   Cells(i, y + 13).NumberFormat = "#,##0.00"  
   Cells(i, y + 14).NumberFormat = "#,##0.00"  
   Cells(i, y + 5).Value = Cells(i, y + 4).Value - Cells(i, y + 3).Value  
   Cells(i, y + 2).Value = 30  
   A = Cells(i, y + 5).Value  
   If (A <= 0) Then Cells(i, y + 7).Value = Cells(i, y + 6).Value  
   Else: Cells(i, y + 7).Value = Cells(i, y + 16).Value  
   If ((A > 0) And (A <= 30)) Then Cells(i, y + 8).Value = Cells(i, y + 6).Value  
   Else: Cells(i, y + 8).Value = Cells(i, y + 16).Value  
   If ((A > 30) And (A)) Then Cells(i, y + 9).Value = Cells(i, y + 6).Value  
   Else: Cells(i, y + 9).Value = Cells(i, y + 16).Value  
   If ((A > 45) And (A <= 60)) Then Cells(i, y + 10).Value = Cells(i, y + 6).Value  
   Else: Cells(i, y + 10).Value = Cells(i, y + 16).Value  
   If ((A > 60) And (A <= 75)) Then Cells(i, y + 11).Value = Cells(i, y + 6).Value  
   Else: Cells(i, y + 11).Value = Cells(i, y + 16).Value  
   If ((A > 75) And (A <= 90)) Then Cells(i, y + 12).Value = Cells(i, y + 6).Value  
   Else: Cells(i, y + 12).Value = Cells(i, y + 16).Value  
   If (A > 90) Then Cells(i, y + 13).Value = Cells(i, y + 6).Value  
   Else: Cells(i, y + 13).Value = Cells(i, y + 16).Value  
   Cells(i, y + 14).Value = Cells(i, y + 8).Value + Cells(i, y + 9).Value + Cells(i, y + 10).Value + Cells(i, y + 11).Value + Cells(i, y + 12).Value + Cells(i, y + 13).Value  
Loop  
   j = y  
   i = x  
   Do While ((ColorIndex(Cells(i, y))) <> 21)  
       For j = y + 1 To 14  
           Cells(i, j).Interior.ColorIndex = ColorIndex(Cells(i, x))  
           If Cells(i, j).Interior.ColorIndex = 24 Then Cells(i, j).Value = Cells(x, y + 16).Value  
           End If  
       Next j  
   Loop  
   For j = 6 To 14  
       Summa_po_tsvetam (Cells(x, j))  
   Next j  
End Sub  
 
Подскажите, пожалуйста, в чем моя ошибка?

Спасибо, уважаемые!

Здравствуйте.  
Я создала отдельный модуль с функцией, определяющей цвет фона ячейки.  
Далее пишу макрос, в котором эту функцию использую. При компиляции VBA ругается: Application -defined or object-defined error. Подскажите, что не так?  
 
Sub Макрос3()  
 
   Dim i, j As Integer  
   Dim X, Y, k, color As Integer  
   Dim A As Double  
     
   i = X  
   X = ActiveCell.Row  
   Y = ActiveCell.Column  
   j = 0  
Do While (ColorIndex(Cells(i, Y)) <> 21)  
       If ((ColorIndex(Cells(i, Y)) = 24) And (ColorIndex(Cells(i + 1, Y)) = 24)) Then  
       j = i  
       i = i + 2  
       End If  
       If ((ColorIndex(Cells(i, Y)) = 24) And (ColorIndex(Cells(i + 1, Y)) <> 24)) Then  
       Cells(j, Y) = Cells(j, Y) + Cells(i, Y)  
       i = i + 1  
       Else: i = i + 1  
       End If  
   Loop  
End Sub  
 
Сама функция:  
 
Public Function ColorIndex(Cell As Range)  
   ColorIndex = Cell.Interior.ColorIndex  
End Function  
 
Заранее спасибо!