11. januar 2009 - 13:27Der 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
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.
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
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 ?
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.
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
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 ??
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
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
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)
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
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.