Új hozzászólás Aktív témák

• #11400 m.zmrzlina senior tag Padam #11385

  Új Válasz 2011-09-19 16:17:05 #11400

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  m.zmrzlina

  senior tag

  válasz Padam #11385 üzenetére

  Nem mondom, hogy minden tekintetben végleges megoldás de első körben úgy tűnik működik.

  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cella As Range
  Dim datumoszlop As Integer
  Dim maradekos As Integer
  maradekos = (Target.Column Mod 2)
  
  Select Case maradekos
  Case Is <> 0
  datumoszlop = Target.Column - 1
  Case Is = 0
  datumoszlop = Target.Column
  End Select
  
  If Not Application.Intersect(Target, Range(Cells(3, datumoszlop), Cells(18, datumoszlop + 1))) Is Nothing Then
  For Each cella In Range(Cells(3, datumoszlop), Cells(18, datumoszlop + 1)).Cells
  If Not cella.Address = Target.Address And Target.Value <> "" Then
  If cella.Value = Target.Value Then
  MsgBox Target.Value & " erre az időpontra nem osztható be!"
  Target.Value = ""
  Exit Sub
  End If
  End If
  Next
  End If
  End Sub

  Én a te munkafüzeted B:C oszlopát érvényesítéssel együtt lemásoltam rendre D:E, F:G ...stb-be a dolgozók tartományt pedig áthelyeztem. Teszteld, ha gond van jelezd!

Új hozzászólás Aktív témák