Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Excel-VBA Duplicita_OddelitText

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

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny