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

• #32408 Fferi50 Topikgazda Sprite75 #32397

  Új Válasz 2016-08-21 12:53:15 #32408

  Ú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

  

  Fferi50

  Topikgazda

  válasz Sprite75 #32397 üzenetére

  Szia!

  Íme a makró:
  Ellenőrzi, hogy ne szöveg legyen beírva, érvényes legyen a számérték amit beírtak, illetve rákérdez, hogy felülírható-e az egyszer már bevitt számérték. Beírja az utolsó módosítás időpontját az AZ oszlopba (tehát, ha sikeres az új érték beírása a cellába, akkor ír időpontot az AZ oszlopba, egyébként nem).
  Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, ujertek As Integer
Set KeyCells = Range("C4:AY108") ' ez a vizsgálandó terület
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Application.EnableEvents = False
If Not IsNumeric(Target.Value) Then
MsgBox "Nem számot írtál be, kérlek javitsd ki!", vbCritical, "Ellenőrzés"
With Application
.Undo
.EnableEvents = True
End With
Exit Sub
End If
If Target.Value < 0 Or Target.Value > 300 Then
MsgBox "Ez az érték nem felel meg a követelményeknek: " & Target.Value, vbCritical, "Ellenőrzés"
With Application
.Undo
.EnableEvents = True
End With
Exit Sub
End If
ujertek = Target.Value
Application.Undo 'visszaállítjuk a változás előtti értéket
If Target.Value >= 1 And Target.Value <= 300 Then 'ha a régi érték jó
If MsgBox("A(z) " & Target.Address(rowabsolute:=False, columnabsolute:=False) & " cella már tartalmazott egy helyes értéket: " & Target.Value & vbLf & "Kicseréli erre: " & ujertek, vbYesNo, "Ellenőrzés") = vbYes Then
Target.Value = ujertek
End If
Else
Target.Value = ujertek
End If
Cells(Target.Row, 52).Value = Time
Application.EnableEvents = True
End If
End Sub

  Üdv.

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