-
GAMEPOD.hu
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
-
Mutt
aktív tag
válasz lacid90 #15981 üzenetére
Hello,
A megadott adatok alapján faragtam a kódon és felraktam egy mintát ide.
A kód pedig így néz ki, továbbra is egy Backup munkalapra menti a módosításokat:
Option Explicit
Public vEredeti 'ez tartalmazza majd az eredeti értéket
Private Sub Worksheet_Activate()
'ha megnyitjuk a lapot akkor egyből jegyezzük meg hogy mi van a B1 cellában
vEredeti = ActiveSheet.Range("B1").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Const vBackupSheet As String = "Backup"
Dim vLastRow
Dim wsNew As Worksheet
Dim wsCurrent As String
'ha a C1 cella értéke 0 vagy üres
If ActiveSheet.Range("C1").Value = 0 Or ActiveSheet.Range("C1").Value = "" Then
'megnézzük hogy létezik-e a munkalap ahova a korábbi értékeket mentjük
On Error Resume Next
Set wsNew = Worksheets(vBackupSheet)
If Err Then
wsCurrent = ActiveSheet.Name
Set wsNew = Sheets.Add
With wsNew
.Name = vBackupSheet
'ha akarod akkor a lenti sorral rejtetté tudod tenni a lapot
'.Visible = xlSheetHidden
End With
Sheets(wsCurrent).Activate
End If
'megnézzük hogy melyik az utolsó sor a backup munkalapon
vLastRow = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets(vBackupSheet).Range("A:A")) + 1
'ha már nincs a munkalapon több üres sor akkor leállunk a naplózással
If vLastRow > ThisWorkbook.Sheets(vBackupSheet).Rows.Count Then
MsgBox "Nincs több hely a mentésre!", vbOKOnly, "Hiba"
Exit Sub
End If
'adunk egy fejlécet a backup munkalapnak
If vLastRow = 1 Then
ThisWorkbook.Sheets(vBackupSheet).Range("A" & vLastRow) = "Eredeti érték"
vLastRow = vLastRow + 1
End If
'mentjük az eredeti értéket és hogy melyik cellából jött
ThisWorkbook.Sheets(vBackupSheet).Range("A" & vLastRow) = vEredeti
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ha az A1 cellára lépünk, csak akkor jegyezzük meg a B1 értékét
If Target.Address = "$A$1" Then
vEredeti = ActiveSheet.Range("B1").Value
End If
End SubAmi pluszt beletetettem, hogy a munkalap megnyitásakor már megjegyzi az eredeti értéket, mivel előfordulhat az az esete hogy éppen az A1 cellában állsz és az értéket felülírod mozgás nélkül.
Fontos, hogy a makró csak akkor műkődik ha az A1 cellába mindig visszamész, vagyis ha mindig a szerkesztősorban változtatod a cella értékét akkor nem fog műkődni mert a cellából nem mész el.üdv.
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
Új hozzászólás Aktív témák
- Telekom mobilszolgáltatások
- bitpork: Bú. Boci bú- a bornyú kétszer pusztul
- Vírusirtó topic
- Politika
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- Sony MILC fényképezőgépcsalád
- Yettel topik
- iPhone topik
- Kertészet, mezőgazdaság topik
- Kínai cégek segítik ezentúl a Teslát, a Renault-t, a Hyundait és a Toyotát
- További aktív témák...
- Steam, Windows, Origin kulcsok, előfizetések közvetlenül a kiadótól, a LEGJOBB ÁRON!
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Warhammer Online - Age of Reckoning (DE) Collectors Box (Figurával!)
- Canva Pro előfizetés - 1 éves
- World of Warcraft Shadowlands Collectors edition EU EN
- Windows 10, 11 Professional, Home, Enterprise licenckulcsok 64, 32 bit - MEGA Akció!
- Windows Server 2016, 2019, 2022 Standard, Datacenter, Essentials termékkulcsok - MEGA akció!
- Vírusirtó, Antivirus, VPN licenckulcsok - kedvezményes ajánlatok (frissítve: 2024. 05. 01.)
- Office Professional Plus 2013, 2016, 2019, 2021 RETAIL licenckulcsok - MEGA Akció!
- Windows 7 Home Premium, Pro, Ultimate és Windows 8, 8.1 Pro licenckulcsok 64, 32 bit - MEGA Akció!
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: Ozeki Kft.
Város: Debrecen