Muzes pouzit udalostni proeduru viz nize, ktera overi duplicitu v bloku bunek C3:C24, pokud vlozena data vyhovuji, vlozi do odpovidajici bunky v B:B levou cast retezce po mezeru. Dale je osetreno vkladani do vice bunek najednou.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Tmp As Variant
With Target
If .Cells.Count = 1 Then
If .Value <> vbNullString Then
If Not Intersect(Target, Me.Range("c3:c24")) Is Nothing Then
If Application.WorksheetFunction.CountIf(Range("c3:c24"), .Value) < 2 Then
Tmp = Split(.Value, " ")
.Offset(0, -1).Value = Tmp(0)
Else
MsgBox "Duplicitni zadani"
With Application
.EnableEvents = False
Target.Value = vbNullString
.EnableEvents = True
End With
End If
End If
End If
Else
Dim Cll As Range, i As Integer
i = 0
For Each Cll In Target.Cells
If Cll <> vbNullString Then i = i + 1
Next Cll
Set Cll = Nothing
If i > 0 Then
MsgBox "Nelze vlozit data do vice bunek najednou"
With Application
.EnableEvents = False
Target.Value = vbNullString
.EnableEvents = True
End With
End If
End If
End With
End Sub