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

Omlouvam se za zpozdeni s odpovedi,byl jsem mimo domov.
Procedury v modulu listu.
Zabrana rucniho vlozeni dat do C3:C24:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Me.Range("c3:c24")) Is Nothing Then
    If Target.Value <> vbNullString Then
      MsgBox "Nelze rucne zapisovat data do oblasti C3:C24"
      With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
      End With
    End If
  End If
End Sub
vkladani z clipboardu - dvojklik na cilovou bunku v C3:C24, je nutné nastavit odkaz na Microsoft Forms 2.0 Object Library: VBA>Tools>References...:
' je nutné nastavit odkaz na Microsoft Forms 2.0 Object Library: VBA>Tools>References...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim DataObj As New MSForms.DataObject
  Dim Tmp As Variant, OldData As String
  With Target
    If .Cells.Count = 1 Then
      If Not Intersect(Target, Me.Range("c3:c24")) Is Nothing Then
        OldData = .Value ' stara data ulozit
        ' vlozit data z clipboardu
        DataObj.GetFromClipboard
        Application.EnableEvents = False
        Tmp = Split(DataObj.GetText, " ")
        .Value = DataObj.GetText
        ' overit duplicitu
        If Application.WorksheetFunction.CountIf(Range("c3:c24"), .Value) > 1 Then
          .Interior.ColorIndex = 3 ' zvyraznit bunku
          MsgBox "Duplicitni zadani"
          .Value = OldData ' obnovit data a pozadi
          .Interior.ColorIndex = xlNone
        Else
          ' vlozit do B:B levou cast retezce po mezeru
          .Offset(0, -1).Value = Tmp(0)
        End If
        Application.EnableEvents = True
        .Offset(0, -1).Select
      End If
    End If
  End With
  Set DataObj = Nothing
End Sub
Snad to bude vyhovovat.

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