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

• #17022 Mutt senior tag Salex1 #16983

  Új Válasz 2013-03-01 23:58:48 #17022

  Ú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 Salex1 #16983 üzenetére

  Hello,

  A második munkalapon van egy név és egy dátum, ha ez a dátum a mainál régebbi, akkor a nevet kellene áttenni az első munkalap következő üres sorába.

  2 megoldást is találsz itt.

  Az egyik makró mentes, és kimutatást használ.
  Nálam Referencia nevű lapon van az adatsor, ebben van a dátum és egy számított mező (a pivot miatt kell) amely megmondja, hogy lejárt-e már a dátum. Az egész egy igazi táblázatban van, amely biztosítja hogy amikor új sort viszel be akkor a számított mező automatikusan létrejön (nem kell neked másolnod) és hogy a pivot az újabb értékeket is megtalálja. Az első munkalapon pedig van egy kimutatás, amely a fájl minden megnyitásakor automatikusan frissül és a számított mező alapján szűr. Ami gond, hogy a kiimutatás sorba rendez, így nem a dátum szerint fogod látni az eredményeket. És csak akkor frissül ha újra megnyitod a fájlt.

  A másik megoldás pedig egy makró használata, amely a munkalapra váltáskor mindig lefut. Azonban hogy feleslegesen ne vigyen át adatok kell neki egy jelzés azon sorokról amelyeket már átmásolt, ez van a negyedik oszlopban (ez elrejthető ha zavar). Az eredményt a Makroval lapra rakja.

  A kód pedig:
  Private Sub Worksheet_Activate()
  Dim vLastRow As Long
  Const vTargetSheet As String = "Makroval" 'a lap neve ahova másolni kell a lejártakat
  Const vDatumOszlop As Long = 2 'hanyadik oszlopban van a dátum
  Const vFlagOszlop As Long = 4 'jelzés hogy melyik lett másolva már
  Dim i As Long
  
  'megnézük a cél helyen az utolsó sort
  vLastRow = Application.WorksheetFunction.CountA(Sheets(vTargetSheet).Range("A:A")) + 1
  
  'az aktuális lap sorain végigmegyünk
  For i = 2 To Application.WorksheetFunction.CountA(Range("A:A"))
  'ahol nincs kitöltve a másolás oszlop és a dátum a múltban van azokat másoljuk
  If IsEmpty(Cells(i, vFlagOszlop)) And Cells(i, vDatumOszlop) < Date Then
  Range(Cells(i, 1), Cells(i, vDatumOszlop)).Copy Destination:=Sheets(vTargetSheet).Range("A" & vLastRow)
  'flaget beállítjuk
  Cells(i, vFlagOszlop) = "x"
  vLastRow = vLastRow + 1
  End If
  Next i
  
  End Sub

  üdv.

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