CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg
Cookie ikon
Avatar billede bruno1 Novice
10. april 2012 - 15:14 Der er 40 kommentarer og
1 løsning

Slette en række som indeholder specifikt søgeord

Hej

Jeg sidder og smider en masse data ind i et excel regneark og iblandt dette data er der rækker som vil indeholde ordet "_txt_". Er der en måde jeg kan få systemet til at slette den række som indeholder ordet. Jeg ved jeg kan lave en søg og erstat men eftersom rækken indeholder mere end blot det ord er det ikke så lige til.

Mvh

Bruno1
Avatar billede igoogle Forsker
10. april 2012 - 16:25 #1
du kan lave et vba loop der klare opgaven.

ellers kan du sortere efter *_txt_* og slette alle synlige rækker.
Avatar billede bruno1 Novice
10. april 2012 - 16:31 #2
Jeg er ikke nok inde i excel til at vide helt hvad du mener. Hvordan skulle jeg lave det som et loop eller endnu bedre hvordan sorterer jeg så rækkerne med "_txt_" kommer øverst. "_txt_" står inde midt i teksten i rækkerne

mvh

Bruno1
Avatar billede store-morten Ekspert
10. april 2012 - 16:49 #3
Hvilken kolonne står _txt_ i?
Hvor mange rækker skal slettes?
Avatar billede bruno1 Novice
10. april 2012 - 16:56 #4
det vil altid være kolonne 3 _txt_ findes i og det er som oftest 200-300 rækker det skal findes og fjernes fra
Avatar billede store-morten Ekspert
10. april 2012 - 17:07 #5
Prøv denne makro på en kopi først
Sub Makro1()
Dim sidst As Range
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Rows("2:1000").Delete Shift:=xlUp
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub
Avatar billede store-morten Ekspert
10. april 2012 - 17:08 #6
Sub Makro1()
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Rows("2:1000").Delete Shift:=xlUp
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

Der var lige en linie for meget
Avatar billede store-morten Ekspert
10. april 2012 - 17:51 #7
Denne finder selv sidste række.

Koier koden her under
Tryk alt+F11
Dobbelt klik på det Ark makroen skal virke på
Tryk ctrl+v og luk på det røde kryds.
Tryk alt+F8 Vælg koden og tryk Afspil

Sub SletRkMed_txt_i_C()
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
    Rows("2:" & Sidste).Delete Shift:=xlUp
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub


Eller Manuelt:

Klik på " C "
Tryk ctrl+skift+l
Klik på den lille pil i cell C1
Vælg" Talfilter" -->
Vælg "Brugerdefineret filter"
Vælg "Indeholder" og skriv _txt_ --> OK
Marker Rækker og tryk Delete
Klik på den lille pil i cell C1
Vælg "Marker alt"  --> OK
Tryk ctrl+skift+l
Avatar billede bruno1 Novice
10. april 2012 - 19:12 #8
Store-Morten du er for vild!

Det virker helt perfekt!

Min dag er lige blevet 30 arbejds-minutter kortere :-)

tak for den udførelige beskrivelse så en ikke pro også kan følge med!

Mvh

Bruno1
Avatar billede bruno1 Novice
10. april 2012 - 19:13 #9
Smid et svar så du kan få points!

Ps - tak til jer andre også!

B.
Avatar billede store-morten Ekspert
10. april 2012 - 19:37 #10
Velbekomme
Og tak for rosen ;-)
Avatar billede store-morten Ekspert
12. april 2012 - 00:04 #11
Sub Auto_Open()
'  Creates a new menu and adds menu items
    Dim Cap(1 To 1)
    Dim Mac(1 To 1)
    Dim MenuName As String
   
    MenuName = "&Brunos_Menu"
   
    Cap(1) = "Slet Rækkerk med _txt_ i C "
    Mac(1) = "mac1"
'    Cap(2) = "Ikke i brug"
'    Mac(2) = "mac2"
'    Cap(3) = "Ikke i brug"
'    Mac(3) = "mac3"
'    Cap(4) = "Ikke i brug"
'    Mac(4) = "mac4"
'    Cap(5) = "Ikke i brug"
'    Mac(5) = "mac5"
'    Cap(6) = "Ikke i brug"
'    Mac(6) = "mac6"
'    Cap(7) = "Ikke i brug"
'    Mac(7) = "mac7"
   
    On Error Resume Next
'  Delete the menu if it already exists
    MenuBars(xlWorksheet).Menus(MenuName).Delete
   
'  Add the menu
    MenuBars(xlWorksheet).Menus.Add Caption:=MenuName, before:="Help"
   
'  Add the menu items
    With MenuBars(xlWorksheet).Menus(MenuName).MenuItems
   
        .Add Caption:=Cap(1), OnAction:=Mac(1)
'        .Add Caption:=Cap(2), OnAction:=Mac(2)
'        .Add Caption:="-"
'        .Add Caption:=Cap(3), OnAction:=Mac(3)
'        .Add Caption:=Cap(4), OnAction:=Mac(4)
'        .Add Caption:="-"
'        .Add Caption:=Cap(5), OnAction:=Mac(5)
'        .Add Caption:=Cap(6), OnAction:=Mac(6)
'        .Add Caption:="-"
'        .Add Caption:=Cap(7), OnAction:=Mac(7)
       
    End With
End Sub

Sub Auto_Close()
    Dim MenuName As String
    MenuName = "&Brunos_Menu"
'  Delete the menu before closing
    On Error Resume Next
    MenuBars(xlWorksheet).Menus(MenuName).Delete
End Sub

Sub mac1()
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
    Rows("2:" & Sidste).Delete Shift:=xlUp
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

Sub mac2()

End Sub

Sub mac3()

End Sub

Sub mac4()

End Sub

Sub mac5()

End Sub

Sub mac6()

End Sub

Sub mac7()

End Sub
Avatar billede store-morten Ekspert
12. april 2012 - 00:12 #12
Kopier koden her over
Tryk alt+F11
Dobbelt klik på et Ark
Menuen 'Insert' --> vælg "Module"
Tryk ctrl+v og luk på det røde kryds.
Luk og Gem filen et sted du kan finde igen ;-)
Åben den, og kik efter Brunos Menu, under Tilføjelsprogrammer.
Avatar billede store-morten Ekspert
12. april 2012 - 00:28 #13
Nej, men prøv at kontrollere at, det er som du ønsker ;-)

Der kommer lidy mere om lidt.
Avatar billede bruno1 Novice
12. april 2012 - 00:23 #14
luk og gem filen siger du.

skal det ske mens jeg stadig er i visual basic for applications eller skal det lukkes helt væk så jeg er tilbage på regnearket?

Når jeg forsøger at gemme normalt siger den:
Følgende kan ikke gemmes i projektmapper uden makroer:

- VB-projekt

Hvis du vil gemme en fil med disse funktioner skal du klikke nej og vælge en makrobaseret filtype osv.

hvad skal jeg gøre der?


B.
Avatar billede bruno1 Novice
12. april 2012 - 00:25 #15
Og den fil jeg forsøger at gemme "mappe1" som den selv foreslår, er det den jeg skal åbne fra nu af hvis jeg vil kunne bruge din macro?
Avatar billede store-morten Ekspert
12. april 2012 - 00:34 #16
#13
Når du gemmer, skal du under navnet, skifte filtypen, til: Excel-projecktmappe med aktive makroer
Avatar billede bruno1 Novice
12. april 2012 - 00:31 #17
du skriver

Dobbelt klik på et Ark
Menuen 'Insert' --> vælg "Module"

når jeg dobbeltklikker på et ark kommer der jo en hvid kasse frem jeg kan skrive i og når jeg så derefter tager insert --> module kommer der jo en hvid kasse mere frem jeg kan skrive i. Hvilken af dem skal jeg smide koden i?
Avatar billede store-morten Ekspert
12. april 2012 - 00:34 #18
#16 Den sidste
Avatar billede bruno1 Novice
12. april 2012 - 00:37 #19
ok nu kom den frem i tilføjelsesmenuen :-) og funktionen sletter _txt_ som den skal :-)

Smuk smukt smukt Morten

er det let at tilføje yderligere punkter? Hvis nu jeg også ville kunne slette _track_ fra C
Avatar billede store-morten Ekspert
12. april 2012 - 00:39 #20
Ja, som du ser er koden lang ;-)
Forberedt til 6 makroer mere.
Avatar billede store-morten Ekspert
12. april 2012 - 00:43 #21
Så skal du have lagt din Menu kode ind i din 'Personlig makromappe'
Så skal tungen holdes lige i munden ;-)

Menuen Udvikler -->
Menuen Kode --> "Indspil makro"
Vigtigt! 'Gem makro i:' --> ændres til "Personlig makromappe" --> OK
Klik på en tilfældig celle --> Menuen Kode --> "Stop indspilling"

Tryk alt+F11
Under VBAProject(PERSONAL.XLSB) --> 'Modules' --> dobbeltklik på 'Module1' i kassen vil der stå noget med:

Sub Makro1()
'
' Makro1 Makro
'

'
    Range("C7").Select
End Sub

Erstat det med koden fra før. Luk og Gem alt.

NU... skulle det virker når du åbner et "Nyt" ark.
Avatar billede bruno1 Novice
12. april 2012 - 00:43 #22
så hvis jeg tager

Sub mac1()
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
    Rows("2:" & Sidste).Delete Shift:=xlUp
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

og bytter _txt_ ud med _track_ og sætter det ind imellem
Sub mac2()

End Sub

og kører hele processen igen så vil der dukke endnu et menupunkt op?
Avatar billede store-morten Ekspert
12. april 2012 - 00:49 #23
Kode med _txt_ og _track_

Sub Auto_Open()
'  Creates a new menu and adds menu items
    Dim Cap(1 To 2)
    Dim Mac(1 To 2)
    Dim MenuName As String
   
    MenuName = "&Brunos_Menu"
   
    Cap(1) = "Slet Rækkerk med _txt_ i C "
    Mac(1) = "mac1"
    Cap(2) = "Slet Rækkerk med _track_  i C "
    Mac(2) = "mac2"
'    Cap(3) = "Ikke i brug"
'    Mac(3) = "mac3"
'    Cap(4) = "Ikke i brug"
'    Mac(4) = "mac4"
'    Cap(5) = "Ikke i brug"
'    Mac(5) = "mac5"
'    Cap(6) = "Ikke i brug"
'    Mac(6) = "mac6"
'    Cap(7) = "Ikke i brug"
'    Mac(7) = "mac7"
   
    On Error Resume Next
'  Delete the menu if it already exists
    MenuBars(xlWorksheet).Menus(MenuName).Delete
   
'  Add the menu
    MenuBars(xlWorksheet).Menus.Add Caption:=MenuName, before:="Help"
   
'  Add the menu items
    With MenuBars(xlWorksheet).Menus(MenuName).MenuItems
   
        .Add Caption:=Cap(1), OnAction:=Mac(1)
        .Add Caption:=Cap(2), OnAction:=Mac(2)
'        .Add Caption:="-"
'        .Add Caption:=Cap(3), OnAction:=Mac(3)
'        .Add Caption:=Cap(4), OnAction:=Mac(4)
'        .Add Caption:="-"
'        .Add Caption:=Cap(5), OnAction:=Mac(5)
'        .Add Caption:=Cap(6), OnAction:=Mac(6)
'        .Add Caption:="-"
'        .Add Caption:=Cap(7), OnAction:=Mac(7)
       
    End With
End Sub

Sub Auto_Close()
    Dim MenuName As String
    MenuName = "&Brunos_Menu"
'  Delete the menu before closing
    On Error Resume Next
    MenuBars(xlWorksheet).Menus(MenuName).Delete
End Sub

Sub mac1()
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
    Rows("2:" & Sidste).Delete Shift:=xlUp
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

Sub mac2()
Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_track_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
    Rows("2:" & Sidste).Delete Shift:=xlUp
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

Sub mac3()

End Sub

Sub mac4()

End Sub

Sub mac5()

End Sub

Sub mac6()

End Sub

Sub mac7()

End Sub
Avatar billede store-morten Ekspert
12. april 2012 - 00:52 #24
#21 Jep..

Og ret:
Dim Cap(1 To 1)
Dim Mac(1 To 1)
Til:
Dim Cap(1 To 2)
Dim Mac(1 To 2)

Og slet et par ' af disse
Avatar billede bruno1 Novice
12. april 2012 - 00:55 #25
jeg tror det virker :-)

har gemt den i den personlige mappe og har prøvet at lukket excel helt ned og genåbne og under menuen tilføjelsesprogrammer kan jeg stadig vælge macroen og den virker :-)

Jeg tror godt jeg kan gennemskue hvordan opbygningen af yderligere macros er efter du lavede den nye kode med både _txt_ og _track_

:-)

Det er virkelig cool! Mit liv er lige blevet meget lettere hehe

Endnu engang mange tak for din hjælp! Det var aldrig gået uden din assistance!

(nu må vi se hvor længe der går før jeg har ødelagt et eller andet)  :-)


Bruno
Avatar billede store-morten Ekspert
12. april 2012 - 00:57 #26
Så er der jo altid nogen på "Eksperten" ;-)
Avatar billede bruno1 Novice
12. april 2012 - 00:57 #27
"'" gør at programmet ikke læser linien?
Avatar billede bruno1 Novice
12. april 2012 - 00:59 #28
hmm det blev lidt sært mit sidste indlæg :-)  det tegn her ' gør at programmet ikke læser linien går jeg ud fra?
Avatar billede store-morten Ekspert
12. april 2012 - 01:00 #29
Ja, bruges også til kommentare, så man kan huske hvad koden gør.
Avatar billede store-morten Ekspert
14. april 2012 - 12:20 #30
Tip:
Efter at have indspillet makro til den 'Personlig makromappe' sæt tilbage til 'Denne projektmappe'

Menuen Udvikler -->
Menuen Kode --> "Indspil makro"
Vigtigt! 'Gem makro i:' --> ændres igen til "Denne projektmappe" --> Luk på det røde kryds.

Ellers vil alle fremtidige indspillede makroer gemmes i den 'Personlig makromappe'
Avatar billede store-morten Ekspert
29. april 2012 - 21:24 #31
Sub Auto_Open()
'  Creates a new menu and adds menu items
    Dim Cap(1 To 3)
    Dim Mac(1 To 3)
    Dim MenuName As String
   
    MenuName = "&Brunos_Menu"
   
    Cap(1) = "Slet Rækker med _txt_ i C "
    Mac(1) = "mac1"
    Cap(2) = "Slet Rækker med _track_ i C "
    Mac(2) = "mac2"
    Cap(3) = "Slet Rækker 'Indtastning'"
    Mac(3) = "mac3"
'    Cap(4) = "Ikke i brug"
'    Mac(4) = "mac4"
'    Cap(5) = "Ikke i brug"
'    Mac(5) = "mac5"
'    Cap(6) = "Ikke i brug"
'    Mac(6) = "mac6"
'    Cap(7) = "Ikke i brug"
'    Mac(7) = "mac7"
   
    On Error Resume Next
'  Delete the menu if it already exists
    MenuBars(xlWorksheet).Menus(MenuName).Delete
   
'  Add the menu
    MenuBars(xlWorksheet).Menus.Add Caption:=MenuName, before:="Help"
   
'  Add the menu items
    With MenuBars(xlWorksheet).Menus(MenuName).MenuItems
   
        .Add Caption:=Cap(1), OnAction:=Mac(1)
        .Add Caption:=Cap(2), OnAction:=Mac(2)
        .Add Caption:="-"
        .Add Caption:=Cap(3), OnAction:=Mac(3)
'        .Add Caption:=Cap(4), OnAction:=Mac(4)
'        .Add Caption:="-"
'        .Add Caption:=Cap(5), OnAction:=Mac(5)
'        .Add Caption:=Cap(6), OnAction:=Mac(6)
'        .Add Caption:="-"
'        .Add Caption:=Cap(7), OnAction:=Mac(7)
       
    End With
End Sub

Sub Auto_Close()
    Dim MenuName As String
    MenuName = "&Brunos_Menu"
'  Delete the menu before closing
    On Error Resume Next
    MenuBars(xlWorksheet).Menus(MenuName).Delete
End Sub

Sub mac1()
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
If Sidste = 1 Then GoTo Ingen
    Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

Sub mac2()
Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_track_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
If Sidste = 1 Then GoTo Ingen
    Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

Sub mac3()
        Dim svar1 As String
        Dim svar2 As String
        svar1 = InputBox("Indtast kolonne bogstav")
        svar2 = InputBox("Indtast søge ord?")
On Error GoTo ExitSub
   
Columns(svar1 & ":" & svar1).Select
    Selection.AutoFilter
    ActiveSheet.Range(svar1 & ":" & svar1).AutoFilter Field:=1, Criteria1:="=*" & svar2 & "*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, svar1).End(xlUp).Row
    Rows("2:" & Sidste).Delete Shift:=xlUp
If Sidste = 1 Then GoTo Ingen
    ActiveSheet.Range(svar1 & ":" & svar1).AutoFilter Field:=1
Ingen:
    Selection.AutoFilter
    Range("A1").Select
ExitSub:
Exit Sub
End Sub
Avatar billede store-morten Ekspert
29. april 2012 - 21:35 #32
Der er rettet, så ingen rækker slettes, hvis der ingen match er.
Avatar billede bruno1 Novice
29. april 2012 - 21:42 #33
ja stemmer det ikke at den kunne finde på at slette noget der ikke var meningen før. Kunne ikke helt sætte min finger på hvad det var, troede bare det var mig der gjorde noget galt :-)
Avatar billede store-morten Ekspert
29. april 2012 - 21:49 #34
Jo, hvis den ikke fandt noget at slette, slettede den række 1
Avatar billede bruno1 Novice
29. april 2012 - 21:51 #35
Aha! altid rart at vide man ikke er helt skør endnu :-) Den gør stadig min hverdag lettere så endnu engang tak for din tid!
Avatar billede store-morten Ekspert
29. april 2012 - 21:53 #36
Og så er der lige en lille fejl sidst i koden ;-(

Omtalte rettelse, sat forkert i den nye:
Sub Auto_Open()
'  Creates a new menu and adds menu items
    Dim Cap(1 To 3)
    Dim Mac(1 To 3)
    Dim MenuName As String
   
    MenuName = "&Brunos_Menu"
   
    Cap(1) = "Slet Rækker med _txt_ i C "
    Mac(1) = "mac1"
    Cap(2) = "Slet Rækker med _track_ i C "
    Mac(2) = "mac2"
    Cap(3) = "Slet Rækker 'Indtastning'"
    Mac(3) = "mac3"
'    Cap(4) = "Ikke i brug"
'    Mac(4) = "mac4"
'    Cap(5) = "Ikke i brug"
'    Mac(5) = "mac5"
'    Cap(6) = "Ikke i brug"
'    Mac(6) = "mac6"
'    Cap(7) = "Ikke i brug"
'    Mac(7) = "mac7"
   
    On Error Resume Next
'  Delete the menu if it already exists
    MenuBars(xlWorksheet).Menus(MenuName).Delete
   
'  Add the menu
    MenuBars(xlWorksheet).Menus.Add Caption:=MenuName, before:="Help"
   
'  Add the menu items
    With MenuBars(xlWorksheet).Menus(MenuName).MenuItems
   
        .Add Caption:=Cap(1), OnAction:=Mac(1)
        .Add Caption:=Cap(2), OnAction:=Mac(2)
        .Add Caption:="-"
        .Add Caption:=Cap(3), OnAction:=Mac(3)
'        .Add Caption:=Cap(4), OnAction:=Mac(4)
'        .Add Caption:="-"
'        .Add Caption:=Cap(5), OnAction:=Mac(5)
'        .Add Caption:=Cap(6), OnAction:=Mac(6)
'        .Add Caption:="-"
'        .Add Caption:=Cap(7), OnAction:=Mac(7)
       
    End With
End Sub

Sub Auto_Close()
    Dim MenuName As String
    MenuName = "&Brunos_Menu"
'  Delete the menu before closing
    On Error Resume Next
    MenuBars(xlWorksheet).Menus(MenuName).Delete
End Sub

Sub mac1()
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
If Sidste = 1 Then GoTo Ingen
    Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

Sub mac2()
Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_track_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
If Sidste = 1 Then GoTo Ingen
    Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
End Sub

Sub mac3()
        Dim svar1 As String
        Dim svar2 As String
        svar1 = InputBox("Indtast kolonne bogstav")
        svar2 = InputBox("Indtast søge ord?")
On Error GoTo ExitSub
   
Columns(svar1 & ":" & svar1).Select
    Selection.AutoFilter
    ActiveSheet.Range(svar1 & ":" & svar1).AutoFilter Field:=1, Criteria1:="=*" & svar2 & "*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, svar1).End(xlUp).Row
If Sidste = 1 Then GoTo Ingen
    Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
    ActiveSheet.Range(svar1 & ":" & svar1).AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
ExitSub:
Exit Sub
End Sub
Avatar billede store-morten Ekspert
30. april 2012 - 01:18 #37
Sub Auto_Open()
'  Creates a new menu and adds menu items
    Dim Cap(1 To 4)
    Dim Mac(1 To 4)
    Dim MenuName As String
   
    MenuName = "&Brunos_Menu"
   
    Cap(1) = "Slet Rækker med _txt_ i C "
    Mac(1) = "mac1"
    Cap(2) = "Slet Rækker med _track_ i C "
    Mac(2) = "mac2"
    Cap(3) = "Slet Rækker 'Indtastning'"
    Mac(3) = "mac3"
    Cap(4) = "Slet Rækker fra liste"
    Mac(4) = "mac4"
'    Cap(5) = "Ikke i brug"
'    Mac(5) = "mac5"
'    Cap(6) = "Ikke i brug"
'    Mac(6) = "mac6"
'    Cap(7) = "Ikke i brug"
'    Mac(7) = "mac7"
   
    On Error Resume Next
'  Delete the menu if it already exists
    MenuBars(xlWorksheet).Menus(MenuName).Delete
   
'  Add the menu
    MenuBars(xlWorksheet).Menus.Add Caption:=MenuName, before:="Help"
   
'  Add the menu items
    With MenuBars(xlWorksheet).Menus(MenuName).MenuItems
   
        .Add Caption:=Cap(1), OnAction:=Mac(1)
        .Add Caption:=Cap(2), OnAction:=Mac(2)
        .Add Caption:="-"
        .Add Caption:=Cap(3), OnAction:=Mac(3)
        .Add Caption:=Cap(4), OnAction:=Mac(4)
'        .Add Caption:="-"
'        .Add Caption:=Cap(5), OnAction:=Mac(5)
'        .Add Caption:=Cap(6), OnAction:=Mac(6)
'        .Add Caption:="-"
'        .Add Caption:=Cap(7), OnAction:=Mac(7)
       
    End With
End Sub

Sub Auto_Close()
    Dim MenuName As String
    MenuName = "&Brunos_Menu"
'  Delete the menu before closing
    On Error Resume Next
    MenuBars(xlWorksheet).Menus(MenuName).Delete
End Sub

Sub mac1()
On Error GoTo Slut
home = ActiveCell.Address
homeArk = ActiveSheet.Name

Application.ScreenUpdating = False

    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_txt_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
If Sidste = 1 Then GoTo Ingen
    Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
   
Sheets(homeArk).Select
Range(home).Select

GoTo Slut
Slut:
Application.ScreenUpdating = True
End Sub

Sub mac2()
On Error GoTo Slut
home = ActiveCell.Address
homeArk = ActiveSheet.Name

Application.ScreenUpdating = False

Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*_track_*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, "C").End(xlUp).Row
If Sidste = 1 Then GoTo Ingen
    Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
    ActiveSheet.Range("C:C").AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
   
Sheets(homeArk).Select
Range(home).Select

GoTo Slut
Slut:
Application.ScreenUpdating = True
End Sub

Sub mac3()
On Error GoTo Slut
home = ActiveCell.Address
homeArk = ActiveSheet.Name

Application.ScreenUpdating = False

        Dim svar1 As String
        Dim svar2 As String
        svar1 = InputBox("Indtast kolonne bogstav")
        If svar1 = vbchancel Then GoTo ExitSub
        svar2 = InputBox("Indtast søge ord?")
        If svar2 = vbchancel Then GoTo ExitSub

Columns(svar1 & ":" & svar1).Select
    Selection.AutoFilter
    ActiveSheet.Range(svar1 & ":" & svar1).AutoFilter Field:=1, Criteria1:="=*" & svar2 & "*" _
        , Operator:=xlAnd
    Sidste = Cells(Rows.Count, svar1).End(xlUp).Row
If Sidste = 1 Then GoTo Ingen
    Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
    ActiveSheet.Range(svar1 & ":" & svar1).AutoFilter Field:=1
    Selection.AutoFilter
    Range("A1").Select
   
Sheets(homeArk).Select
Range(home).Select

GoTo Slut
Slut:
Application.ScreenUpdating = True
End Sub

Sub mac4()
On Error GoTo Slut
home = ActiveCell.Address
homeArk = ActiveSheet.Name

Application.ScreenUpdating = False

    Dim iRow As Integer 'Rækken der arbejdes med
    iRow = 2 'Sæt hvilken række der startes fra
   
    Do While Sheets(4).Range("A" & iRow).Value <> "" 'Så længe der er data I kolonne "læsekolonnen"
            søgord = Sheets(4).Range("A" & iRow).Value
       
            Columns("C:C").Select
                Selection.AutoFilter
                ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:="=*" & søgord & "*" _
                    , Operator:=xlAnd
                Sidste = Cells(Rows.Count, "C").End(xlUp).Row
            If Sidste = 1 Then GoTo Ingen
                Rows("2:" & Sidste).Delete Shift:=xlUp
Ingen:
                ActiveSheet.Range("C:C").AutoFilter Field:=1
                Selection.AutoFilter
                Range("A1").Select
         
            iRow = iRow + 1 'Forbered læsning af næste række
    Loop 'Afslut loopet

Sheets(homeArk).Select
Range(home).Select

GoTo Slut
Slut:
Application.ScreenUpdating = True
End Sub
Avatar billede store-morten Ekspert
30. april 2012 - 01:23 #38
Hej Bruno

Prøv at teste oven stående.

Opret et Ark4 (fane) og tast din liste i A2 og ned (Oveskrift i A1: "Søge ord:")
Tip: Sæt evt. mellemrum før og efter "søge ord" for nøjagtighed.
Avatar billede store-morten Ekspert
30. april 2012 - 01:49 #39
If svar1 = vbchancel Then GoTo ExitSub
svar2 = InputBox("Indtast søge ord?")
If svar2 = vbchancel Then GoTo ExitSub

Skal rettes til:

If svar1 = vbchancel Then GoTo Slut
svar2 = InputBox("Indtast søge ord?")
If svar2 = vbchancel Then GoTo Slut
Avatar billede bruno1 Novice
30. april 2012 - 09:17 #40
Mange tak atter engang. Jeg fik ikke testet det i aftes men jeg tjekker og vender tilbage i aften :-)
Avatar billede bruno1 Novice
01. maj 2012 - 00:31 #41
Hey Morten

Jeg har nu haft tid til at teste din nye løsning og det er lige præcis hvad jeg skulle bruge!

Jeg har godt nok kun testet den med mine egne indsatte test lister og ord men det burde jo være det samme når jeg går i krig på de "ægte" lister

Det er super nemt for mig nu at sætte mine ord ind i ark4 og teste dem op mod originallisterne i ark1. Jeg glæder mig helt til at få prøvet det rigtigt imorgen og nyde hvor meget tid det sparer mig for på daglig basis :-)

TAK!

Bruno
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
Kategori
Excel kurser
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
renteberegning Af Pil i Excel 3 24/11/202411:27 25/11/202417:42
Identificér og hent del af tekststreng Af TheLibrarian i Excel 2 22/11/202416:49 25/11/202409:27
Ændre nuller til ovenstående tekst Af boro23 i Excel 4 20/11/202410:44 20/11/202412:08
HVIS med datoer Af HHA i Excel 6 20/11/202408:31 20/11/202412:51
Numerisk liste Af AND i Excel 8 19/11/202414:05 19/11/202423:31
Se alle spørgsmål i kategorien Opret spørgsmål

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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester



Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I dag 08:16 Outlook Af jdann i E-mail programmer
I går 20:00 Genie Timeline Af Malm i Andet software
I går 16:09 Plex virker ikke uden for netværk ??? Af Ronron i Mac
I går 16:03 exFat Af Bruce i Apps til iOS
I går 14:57 Ukendt enhed logget på mit netværk Af KristinaS i Wifi
White papers
Flere white papers »


Premium
Teaser billede
Et år efter hård kritik: En stribe myndigheder har fortsat store huller i deres kriseberedskaber
Læs mere »
Næsten alle de gode navne er taget, men domænehandleren Marcus har en opskrift, der kan hjælpe dig med at kapre drømmeadressen
EU åbner NIS2-sag mod Danmark efter store forsinkelser: Får to måneder
Gør som stort konsulenthus: Rekruttér selv og få bedre kvalitet … og spar en masse penge
Se alle »
Computerworld
Teaser billede
Omfattende netværksproblemer hos TDC: Nu er årsagen muligvis fundet
Læs mere »
Stort Microsoft-nedbrud rammer flere kunder: Problemer med Teams og mails
Stortest: Med USB-C skulle alle kabler være lige - men det er de bare slet ikke
Test: Den snusfornuftige Volkswagen ID.3 blevet til lidt af el-bisse
Se alle »
CIO
Teaser billede
Microsoft hæver priserne på M365: Sådan kommer de nye priser til at ramme
Læs mere »
Stort Microsoft-nedbrud rammer flere kunder: Problemer med Teams og mails
Leverandør til 50 danske kommuner ramt af ransomware: "Det er ikke sjovt," siger direktør Thomas à Porta
Microsoft et døgn efter nedbrud: Stadig problemer med Outlook
Se alle »
Job & Karriere
Teaser billede
Microsoft klar med ny direktion for den danske forretning: Her er de nye direktører
Læs mere »
Efter skelsættende møde med sportscoach: Stor dansk it-arbejdsplads indfører fredags-fri og isbade i arbejdstiden
Linus Torvalds giver russiske Linux-udviklere sparket: Vil ikke have noget med dem at gøre
Twoday er rykket til et af de dyreste postnumre i Danmark – og det kan betale sig, siger topchef Lars Berthelsen
Se alle »
White paper
Teaser billede
Managed Detection & Response: Forsvar din virksomhed mod cybertrusler døgnet rundt
Læs mere »
Derfor kræver AI, cloud og sikkerhed et stærkere netværk
Sæt turbo på din cloudperformance og minimér risikoen for DDoS-angreb
Sikkerhed uden grænser: Cisco Hypershield
Se alle »

Events
Flere events »
White papers
Flere white papers »
IT-Kurser
Se alle vores it-kurser »