-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
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
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Apple iPhone 15 Pro Max - Attack on Titan
- Tomato firmware
- Xiaomi 13T és 13T Pro - nincs tétlenkedés
- Milyen okostelefont vegyek?
- Windows 10
- Kodi és kiegészítői magyar nyelvű online tartalmakhoz (Linux, Windows)
- Milyen monitort vegyek?
- NVIDIA GeForce RTX 5070 / 5070 Ti (GB205 / 203)
- Google Pixel topik
- További aktív témák...
- AKCIÓ! Apple Macbook Pro 16" 2019 i9 9980HK 64GB DDR4 512GB SSD Radeon Pro 5500M garanciával
- ÁRGARANCIA!Épített KomPhone Ryzen 7 5700X 16/32/64GB RAM RTX 3060 12GB GAMER PC termékbeszámítással
- ÁRGARANCIA! Épített KomPhone Ultra 9 285K 64GB RAM RTX 5090 32GB GAMER PC termékbeszámítással
- Újabb 20 db Lenovo ThinkPad X1 Yoga G6 (6th Gen) - i7-1185G7, 32GB, 512GB SSD, multitouch + TOLL
- iPhone XR 64GB Black -1 ÉV GARANCIA - Kártyafüggetlen, MS3115
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő