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

• #20653 Delila_1 veterán Louro #20649

  Új Válasz 2014-02-25 09:23:25 #20653

  Ú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 Louro #20649 üzenetére

  Nem biztos, hogy jól értem.
  Tehát megnyitsz egy füzetet. Az utolsó oszlop füzetenként máshol van, de mindig az utolsó mínusz 2. oszlopban vannak #N/A értékek, amik szerint a sorokat törölni akarod.

  Próbáld ezzel a makróval:

  Sub HibasSorokTorlese()
  Dim usor As Long, oszlop As Long, betu As String
  
  usor = Range("B" & Rows.Count).End(xlUp).Row
  oszlop = Range("A1").End(xlToRight).Column
  
  'Utolsó oszlop-2 első sorába a hibákat tartalmazó oszlop betűjele
  Cells(1, oszlop + 3) = "=CHAR(" & oszlop - 2 + 64 & ")"
  betu = Cells(1, oszlop + 3)
  
  'Autoszűrő kiterjesztése az utolsó oszlop+1 területre
  Range(Cells(1, 1), Cells(1, oszlop)).Select
  Selection.AutoFilter
  
  Range(Cells(1, 1), Cells(1, oszlop + 1)).Select
  Selection.AutoFilter
  
  'Segédoszlopba fejléc
  Cells(1, oszlop + 1) = "Hibák"
  
  'Képlet a segédoszlopba
  Range(Cells(2, oszlop + 1), Cells(usor, oszlop + 1)) = "=IF(ISERROR(" & betu & "2),1,0)"
  
  'Autoszűrés a hibákat tartalmazó oszlop szerint
  On Error GoTo Vege
  ActiveSheet.Range(Cells(1), Cells(usor, oszlop + 1)).AutoFilter Field:=oszlop + 1, Criteria1:=1
  
  'Látható sorok kijelölése és törlése
  Range("C2:C" & usor).SpecialCells(xlCellTypeVisible).Select
  Selection.Rows.Delete shift:=xlUp
  
  Vege:
  'Autoszűrő minden megmaradt sort mutasson
  ActiveSheet.Range("A1:C" & usor).AutoFilter Field:=oszlop + 1
  End Sub

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