Avatar billede club-p Nybegynder
11. januar 2009 - 13:27 Der er 23 kommentarer og
1 løsning

Slet data via makro eller VBA

Hej Eksperter

Jeg har et stort regneark med rigtigt mange data. Men det er kun nogle af dataene jeg skal bruge.

Jeg har brugt de der filtre man kan bruge i Excel til at udelukke de data jeg ikke vil bruge - men problemet er at når jeg kopier de data jeg gerne vil bruge (dem filterne ikke har sorteret fra) tage den alle de data med som jeg ikke vil bruge (dem filterne har sorteret fra)

Så jeg ville gerne slette alle de data jeg ikke skal bruge permanent, men hvordan gør jeg det.

Jeg havde selv forestillet mig at det kunne gøres via en makro eller noget VBA, men problemet er at jeg ikke kan finde ud af at skrive sådan noget.

Er der en af jer der kan skrive en makro som gør følgende:

Makroen skal slette alle de rækker hvor
kolonne A ikke indeholder tallet 1
Kolonne F ikke indeholder teksten MATCH ODDS
Kolonne P ikke indeholder teksten PE eller teksten IP


Når du ligger dit svar må du meget gerne skære helt ud i pap hvad jeg skal gøre for jeg er ikke så god til det med makroer og VBA
Avatar billede excelent Ekspert
11. januar 2009 - 13:33 #1
Skal alle 3 betingelser være opfyldt i hver række
eller blot 1 af dem ?
Avatar billede jkrons Professor
11. januar 2009 - 13:37 #2
Prøv at se på Avanceret filter. Her har du mulighed for at lade resultatetv af din filtrering stå et andet sted. Dette område kan du så kopiere, uden at de data, du har filtrret fra, kommer med.
Avatar billede club-p Nybegynder
11. januar 2009 - 14:00 #3
excelent>  Jeg skal kun havde de rækker tilbage hvor alle 3 betingelser er overholdt :o)
Avatar billede excelent Ekspert
11. januar 2009 - 14:43 #4
Tast ALT+F11 - åbner vba-editor
I menuen Insert vælg Module
Indsæt koden der, men ret først Ark1 i linie 2 til aktuel arknavn

Sub tst()
Set sh1 = Sheets("Ark1")
rk = sh1.Cells(65500, 1).End(xlUp).Row
For t = rk To 1 Step -1
x = Cells(t, "A") & Cells(t, "F") & Cells(t, "P")
If x <> "1MATCH ODDSPE" And x <> "1MATCH ODDSIP" Then Cells(t, 1).EntireRow.Delete
Next
End Sub

ALT+q - returnerer til arket
Her taster du ALT+F8 - vælg tst og Afspil

Prøv først på en kopi - backup er en go ting :-)
Avatar billede club-p Nybegynder
11. januar 2009 - 17:14 #5
Excelent> Det virker ikke. jeg har skiftet "Ark1" ud med det aktuelle arknavn

Når jeg køre makroen sletter den bare den øvereste række den øvereste række indeholder overskrifterne)
Avatar billede excelent Ekspert
11. januar 2009 - 17:40 #6
udskift denne
For t = rk To 1 Step -1
med denne
For t = rk To 2 Step -1

kan der stå andet end 1 i en celle i kolonne A ?
kan der stå andet end MATCH ODDS i en celle i kolonne F ?
kan der stå andet end PE eller IP i en celle i kolonne P ?
Avatar billede club-p Nybegynder
11. januar 2009 - 22:30 #7
Ja der kan godt stå andet end værdierne i cellerne, men der hvor der står andet end de nævnte værdier (1 i kolonne A, MATCH ODDS i kolonne F, teksten PE eller teksten IP i kolonne P) skal rækken slettes permenent.


Alle kritier skal være opfyldt ellers skal rækken slettes.
Avatar billede excelent Ekspert
11. januar 2009 - 23:17 #8
prøv denne

Sub Slet()
Application.Calculation = xlCalculationManual
Set sh1 = Sheets("Ark1")
rk = Cells(65500, 1).End(xlUp).Row

For t = 2 To rk
If InStr(sh1.Cells(t, "A"), "1") And InStr(sh1.Cells(t, "F"), "MATCH ODDS") And _
InStr(sh1.Cells(t, "P"), "PE") Or InStr(sh1.Cells(t, "P"), "IP") Then sh1.Cells(t, 256) = 1
Next

sh1.Range("IV2:IV" & rk).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
sh1.Range("IV2:IV" & rk) = ""
ActiveCell.Select
Application.Calculation = xlCalculationAutomatic
End Sub
Avatar billede club-p Nybegynder
12. januar 2009 - 10:50 #9
Hej Excelent>

Jeg har prøvet din nye kode men når jeg bruger den siger excel følgende:


Run-time error 1004
Der blev ikke fundet nogen celler
Avatar billede club-p Nybegynder
12. januar 2009 - 11:30 #10
Excelent>

Hvis jeg må vil jeg meget gerne sende dig arket så er det måske lidt letter for dig at afprøve det.

Må jeg det ??
Hvis jeg må hvad er din e-mail adresse ??
Avatar billede excelent Ekspert
12. januar 2009 - 13:17 #11
ok
pm@madsen.tdcadsl.dk
Avatar billede club-p Nybegynder
12. januar 2009 - 13:57 #12
Mail sendt
Avatar billede excelent Ekspert
12. januar 2009 - 16:45 #13
Hej club-p kan du ikke sende den igen, har lige haft problemer med min mail - skulle vær ok nu.
Avatar billede club-p Nybegynder
12. januar 2009 - 18:44 #14
Mail sendt igen :o)
Avatar billede club-p Nybegynder
12. januar 2009 - 18:56 #15
Excelent> Jeg har lige fået en mail hvor der står at du ikke kunne modtage min mail.

Jeg har oploadet filen til en ftp. Du kan hente den her:
http://www.the-club.dk/Excelent.zip
Avatar billede excelent Ekspert
12. januar 2009 - 20:29 #16
Avatar billede club-p Nybegynder
12. januar 2009 - 21:59 #17
excelent> Når jeg åbner dit ark og trykker alt+F8 kan jeg ikke se din makro. Kan det være fordi du har gemt filen i en filtype som ikke understøtter makroer ??
Avatar billede excelent Ekspert
12. januar 2009 - 22:09 #18
Nej den gemte ikke makro sammen med filen
Jeg anvender ver.2003 din fil er vist ver.2007
Her er koden jeg anvendte, det tager tid at slette så mange rækker

Sub tst()
Application.ScreenUpdating = False
For t = 65536 To 2 Step -1
x = Cells(t, "A") & Cells(t, "F") & Cells(t, "P")
If x <> "1Match OddsPE" And x <> "1Match OddsIP" Then Cells(t, 1).EntireRow.Delete
Next
Application.ScreenUpdating = True
End Sub
Avatar billede excelent Ekspert
12. januar 2009 - 22:17 #19
Nu var der vel ikke mere end 65536 rækker i den fil du sendte
for version 2003 kan kun håntere netop 65536 ?
Avatar billede excelent Ekspert
12. januar 2009 - 22:27 #20
Denne er en hel del hurtigere

Sub tst2()
Application.ScreenUpdating = False
For t = 65536 To 2 Step -1
x = Cells(t, "A") & Cells(t, "F") & Cells(t, "P")
If x <> "1Match OddsPE" And x <> "1Match OddsIP" Then Cells(t, 1).ClearContents
Next
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Avatar billede club-p Nybegynder
13. januar 2009 - 11:30 #21
Excelent>

Det virker :o) (Hvis du ligger et svar får du pointene

Jeg har lige et hurtigt spørgsmål. Jeg har yderligere et krav til hvilke rækker der må være tilbage når makroen har kørt. Kravet er at der et eller andet sted i kolonne D skal stå "Spanish Soccer/"  (I arket kan der godt står tekst både foran og efter teksten "Spanish Soccer/" men alle rækker hvor der i kolonne D står "Spanish Soccer/" skal forblive)

Hvordan kommer hele makroen til at se ud (de kriterier du lavet i den forrige makro skal også stadigvæk være der)
Avatar billede excelent Ekspert
13. januar 2009 - 13:11 #22
ser på det efter arbejdstid
Avatar billede excelent Ekspert
13. januar 2009 - 16:05 #23
Sub tst2()
Application.ScreenUpdating = False
For t = 65536 To 2 Step -1
x = Cells(t, "A") & Cells(t, "F") & Cells(t, "P")
If x <> "1Match OddsPE" And x <> "1Match OddsIP" And InStr(Cells(t, "D"), "Spanish Soccer") > 0 Then Cells(t, 1).ClearContents
Next
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Denne sletter ikke hvis "Spanish Soccer" findes i D samtidig med de 3 andre betingelser
Hvis den skal bevare alle rækker hvor "Spanish Soccer" findes i D uanset de 3 andre betingelser skal du ændre >0 til =0 i linie 5
Avatar billede club-p Nybegynder
15. januar 2009 - 16:36 #24
Mange tak for hjælpe :o)
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