Avatar billede boro23 Forsker
28. december 2020 - 11:05 Der er 6 kommentarer og
1 løsning

Slet rækker med vba

Har et regneark, hvor jeg har behov for at slette de række der har et x i kolonne A, samt en msg box med spørgsmålet "Vi du slette? Klik OK for at slette".
Kan I hjælpe :-)
Avatar billede kim1a Ekspert
28. december 2020 - 16:35 #1
Vil du have den til at løbe alle rækker igennem en for en?

Ofte giver det loop mening ved at starte nedefra - er der udfyldt f.eks. i kolonne B sidste række?
Avatar billede boro23 Forsker
29. december 2020 - 06:12 #2
Hvad der er nemmest, der er ca. 25000 rækker i filen, de celler i kolonne A der er tastet et x, skal hele rækken slettes.
Avatar billede store-morten Ekspert
29. december 2020 - 10:37 #3
Prøv denne i en kopi:
Sub Slet_x()

On Error GoTo errorhandler

    'Sætter autufilter
    ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="x"
   
    With ActiveSheet.AutoFilter.Range
        'Første række
        frow = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).Row
    End With
        'Sidste række
        lrow = Range("A" & Rows.Count).End(xlUp).Row
       
    'Sletter rækker med x i kol. A
    Rows(frow & ":" & lrow).Delete Shift:=xlUp
   
errorhandler:
    'Check om der er fiter
    If ActiveSheet.FilterMode = True Then
   
    'Vis alle data
    ActiveSheet.ShowAllData
    End If
   
End Sub
Avatar billede boro23 Forsker
30. december 2020 - 07:02 #4
Hej store-morten
Koden gør hvad den skal, 1000 tak for det :-)
Vil det være muligt at klemt msg box ind med spørgsmålet "Klik OK for at slette" så man lige kan nå se de rækker der skal slettes.
Avatar billede store-morten Ekspert
30. december 2020 - 08:27 #5
Prøv:
Sub Slet_x()
Dim bytAns As Long

On Error GoTo errorhandler

    'Sætter autofilter
    ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="x"
 
    With ActiveSheet.AutoFilter.Range
        'Første række
        frow = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).Row
    End With
        'Sidste række
        lrow = Range("A" & Rows.Count).End(xlUp).Row

    bytAns = MsgBox("Du har anmodet om at slette viste rækker." & _
        vbCrLf & "Ønsker du det?", vbYesNo + vbQuestion, _
        "Bekræft sletning.")
   
    If bytAns = vbYes Then
        'Sletter rækker med x i kol. A
        Rows(frow & ":" & lrow).Delete Shift:=xlUp
    Else
   
    End If
 
errorhandler:
    'Check om der er fiter
    If ActiveSheet.FilterMode = True Then
 
    'Vis alle data
    ActiveSheet.ShowAllData
    End If
 
End Sub
Avatar billede boro23 Forsker
30. december 2020 - 08:40 #6
Bukker mig i støvet, så fint, så fint. 1000 tak og godt nytår :-)
Avatar billede store-morten Ekspert
30. december 2020 - 08:45 #7
Velbekomme 😀
🎊 Tak i lige måde 🎉
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester