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

• #11380 Delila_1 veterán Pulsar #11378

  Új Válasz 2011-09-19 09:12:22 #11380

  Ú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 Pulsar #11378 üzenetére

  Mented a fájlt htm formátumban. Behívod az Excelbe, és lefuttatod az alábbi makrót, amit egy másik füzetben tárolsz.

  Sub Rend()
  Dim usor As Long, sor As Long
  
  Application.ScreenUpdating = False
  
  'Oszlopok törlése
  Range("A:A,E:F").Delete Shift:=xlToLeft
  
  'Objektumok törlése
  ActiveSheet.DrawingObjects.Delete
  
  'Felső sorok törlése
  usor = Range("A1").End(xlDown).Row - 1
  Rows("1:" & usor).Delete Shift:=xlUp
  
  'Összevonások megszüntetése
  Columns("A:C").UnMerge
  
  'Dátum formátum
  usor = Range("A65536").End(xlUp).Row
  Range("A1:A" & usor).Select
  Selection.NumberFormat = "mmmm dd/"
  
  'Üres cellák kitöltése az A oszlopban képlettel
  Selection.SpecialCells(xlCellTypeBlanks).Select
  Selection.FormulaR1C1 = "=R[-1]C"
  
  'Érték beillesztése a képletek helyére
  Columns("A:A").Select
  With Selection
  .Copy
  .PasteSpecial Paste:=xlPasteValues
  End With
  
  'Üres sorok törlése
  For sor = usor To 3 Step -1
  If Cells(sor, 2) = "" Then Rows(sor).Delete Shift:=xlUp
  Next
  
  Range("A1").Select
  Application.ScreenUpdating = True
  
  End Sub

  Mivel a kapitányságok nem egyformán viszik be a dátumot, az A oszlopban lesz némi változatosság.

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