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

• #10646 Delila_1 veterán fess #10635

  Új Válasz 2011-06-29 16:47:20 #10646

  Ú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

  

  Delila_1

  veterán

  válasz fess #10635 üzenetére

  Az két makró ezt csinálja:
  Ha az első lap A1 cellájába beírod a dátumot, automatikusan indul a kigyűjtés erre a lapra, A2-től kezdődően. A beírás indítja az első makrót, ami nekilódítja a másikat.

  Az utóbbi végigszalad a másodiktól az utolsó lapig. Minden lapon végignézi az A oszlopban tárolt dátumokat soronként (amik feltehetően az utolsó karbantartás dátumai).
  Ahol az első lap A1-es dátumánál 90 nappal, vagy annál régebbi dátumot talál, a sor első 15 oszlopát (A:O oszlopok) átmásolja az első lapra egymás alá.

  Ahhoz, hogy automatikusan induljon a kért dátum beírásakor, 2 makró szükséges.
  Az elsőt a gyűjtő (első) laphoz rendeld, a másodikat modulba.

  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$1" Then karbantart
  End Sub
  .
  Sub karbantart()
  Dim sorGy%, lap%, sorLap%, usorLap%
  sorGy% = 2
  Rows("2:10000").ClearContents
  For lap% = 2 To Worksheets.Count
  Sheets(lap%).Select
  usorLap% = Sheets(lap%).Range("A65000").End(xlUp).Row
  For sorLap% = 2 To usorLap%
  If Sheets(1).Cells(1) - Sheets(lap%).Cells(sorLap%, 1) >= 90 Then
  Range(Cells(sorLap%, 1), Cells(sorLap%, 15)).Copy Sheets(1).Cells(sorGy%, 1)
  sorGy% = sorGy% + 1
  End If
  Next
  Next
  Sheets(1).Select
  End Sub

  Ha több oszlopod van, mint 15, a
  Range(Cells(sorLap%, 1), Cells(sorLap%, 15)).Copy Sheets(1).Cells(sorGy%, 1)
  sorban írd át a 15-öt.

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