MS Excel

A dôvod je aký?citovat

2 varianty:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Are As Range, Kde(), H(), i As Long

Set Zmena = Intersect(Cells(2, 2).Resize(Rows.Count - 1), Target)
If Zmena Is Nothing Then Exit Sub
Kde = Worksheets("List2").Range("B2:C27").Value

Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next
For Each Are In Zmena.Areas
With Are
H = .Value
For i = 1 To UBound(H, 1)
H(i, 1) = WorksheetFunction.VLookup(H(i, 1), Kde, 2, False)
If Err.Number <> 0 Then H(i, 1) = Empty: Err.Clear
Next i

.Offset(0, 1).Value = H
End With
Next Are

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range

Set Zmena = Intersect(Cells(2, 2).Resize(Rows.Count - 1), Target)
If Zmena Is Nothing Then Exit Sub

With Zmena.Offset(0, 1)
Application.ScreenUpdating = False
Application.EnableEvents = False

.Formula = "=IFERROR(VLOOKUP(B" & Zmena.Row & ",List2!$B$2:$C$27,2,FALSE),"""")"
.Value = .Value

Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Subcitovat

To musí isť do modulu listu, nie do normálneho modulu. Robil som to tak, aby to zvládlo viacnásobné zmeny, a tak som to aj testoval, ale netestoval som zmenu 1 bunky. Inak by ma trklo, že treba vo verzii 1 doplniť jednoprvkové pole. Takže upravené.
Vo verzii 2 by mohol nastať v špecifickom prípade kopírovania do multioblasti nesprávny výsledok. Išlo o to, že ak by ste skopíroval 2 bunky, a na vloženie by ste označil jednu 2 bunkovú oblasť a o niečo ďalej druhú 1 bunkovú oblasť, Excel automaticky vyplní aj tú jednobunkovú kópiou zdrojovej dvojbunkovej. A tá druhá vrátila zlý výsledok. To si musíte vyskúšať. Opravené.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Are As Range, Kde(), H(), i As Long

Set Zmena = Intersect(Cells(2, 2).Resize(Rows.Count - 1), Target)
If Zmena Is Nothing Then Exit Sub
Kde = Worksheets("List2").Range("B2:C27").Value

Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next
For Each Are In Zmena.Areas
With Are
If .Rows.Count = 1 Then ReDim H(1 To 1, 1 To 1): H(1, 1) = .Value Else H = .Value
For i = 1 To UBound(H, 1)
H(i, 1) = WorksheetFunction.VLookup(H(i, 1), Kde, 2, False)
If Err.Number <> 0 Then H(i, 1) = Empty: Err.Clear
Next i

.Offset(0, 1).Value = H
End With
Next Are

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Are As Range

Set Zmena = Intersect(Cells(2, 2).Resize(Rows.Count - 1), Target)
If Zmena Is Nothing Then Exit Sub

With Zmena.Offset(0, 1)
Application.ScreenUpdating = False
Application.EnableEvents = False

.Formula = "=IFERROR(VLOOKUP(B" & Zmena.Row & ",List2!$B$2:$C$27,2,FALSE),"""")"
For Each Are In .Areas
Are.Value = Are.Value
Next Are
Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Subcitovat