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

• #15980 Mutt senior tag lacid90 #15975

  Új Válasz 2013-01-04 00:05:19 #15980

  Ú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

  

  Mutt

  senior tag

  válasz lacid90 #15975 üzenetére

  Hello,

  Hogyan lehet egy cella értékét eltárolni úgy, hogy lenullázás után is valahol megmaradjon az értéke.

  A munkalap SelectionChange és Change eseményére kell tenned makrókat.
  A Change csak akkor fut le amikor a cella értéke már megváltozott, itt a korábbi értéket már nem látod, ezért érdemes amikor a cellát kiválasztod (ez a SelctionChange) megjegyezni a korábbi értéket.

  Feltöltöttem egy lehetséges megoldást ide
  http://www.filedropper.com/15975backup

  Próbáltam több logikát is beépíteni, amit a kommentek alapján akár te is ki tudsz ütni.
  1. Nyit egy új munkalapot (Backup névvel) és oda menti az eredeti értéket, vmint a módosult cella címét.
  2. Csak akkor ment, ha a cella tényleg megváltozik, ha ugyanaz kerül be akkor nem ment. Ha erre nem tartasz igényt akkor töröld ezt a részt:
  vEredeti <> Target.Resize(1, 1).Value
  3. Nem ment akkor sem, ha üres cella volt eredetileg. Ha ez sem kell, akkor ezt vedd ki:
  And vEredeti <> ""
  4. Ha egy cellában egy képlet van, akkor a képletet másolja és nem az eredményét. Ha ezzel nem akarsz élni, akkor a SelectionChange-ben csak ez legyen:
  vEredeti = Target.Resize(1, 1).Value
  bFuggvenytTartalmaz = False

  Hátrányok:
  1. Érvényesítést (Data Validation-t) használó celláknál nem megy.
  2. Több cella egyidejű módosításakor csak a tartomány bal felső sarkában lévő cellára megy (ennek kikerülésére a második lapon próbáltam egy másik megoldást is csinálni, de az sem 100%-os).
  3. Nem teszteltem túl, ezért lehet benne hiba.

  Itt a kód, ha a fájl már nem lenne letölthető:

  Option Explicit
  Public vEredeti 'ez tartalmazza majd az eredeti értéket
  Public bFuggvenytTartalmaz As Boolean 'ez akkor lehet hasznos ha függvényből jön a cella érték
  
  Private Sub Worksheet_Change(ByVal Target As Range)
  Const vBackupSheet As String = "Backup"
  Dim vLastRow
  Dim wsNew As Worksheet
  Dim wsCurrent As String
  
  'ha az eredeti és az új érték eltér és eredetileg nem üres volt a cella akkor módosítunk
  If vEredeti <> Target.Resize(1, 1).Value And vEredeti <> "" 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 (a B oszlopban mindig lesz érték)
  vLastRow = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets(vBackupSheet).Range("B:B")) + 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"
  ThisWorkbook.Sheets(vBackupSheet).Range("B" & vLastRow) = "Módosított cella"
  vLastRow = vLastRow + 1
  End If
  
  'mentjük az eredeti értéket és hogy melyik cellából jött
  If bFuggvenytTartalmaz Then
  ThisWorkbook.Sheets(vBackupSheet).Range("A" & vLastRow) = "'" & vEredeti
  Else
  ThisWorkbook.Sheets(vBackupSheet).Range("A" & vLastRow) = vEredeti
  End If
  ThisWorkbook.Sheets(vBackupSheet).Range("B" & vLastRow) = Target.Resize(1, 1).Address
  End If
  
  End Sub
  
  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  'ha függvényt tartalmaz a cella, akkor a függvényt másoljuk, különben az értékét
  If Range(Target.Address).Resize(1, 1).HasFormula Then
  vEredeti = Target.Resize(1, 1).Formula
  bFuggvenytTartalmaz = True
  Else
  vEredeti = Target.Resize(1, 1).Value
  bFuggvenytTartalmaz = False
  End If
  
  End Sub

  üdv.

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