Gå til innhold

[Løst] Excel 2007 VBA Slette rader

Bigelk

Av Bigelk
i Programmering og webutvikling

Anbefalte innlegg

Bigelk

Bigelk

Skrevet
Skrevet

Hei.

 

Jeg har en makro som importerer txt filer, etter fila har blitt importert har jeg en kode som sletter rader som ikke skal være med, problemet er at verdien for de radene som ikke som skal være med må hardkodes inn.

 

f.eks

Dim MyRange As Range
Dim x As Long
Dim MyLastRow As Long
Set MyRange = Intersect(ActiveSheet.UsedRange, Range("A:A"))
   MyLastRow = MyRange.Row + MyRange.Rows.Count - 1

For x = MyLastRow To 11 Step -1
If Cells(x, 1).Value = False Or Cells(x, 1).Value = "SEK" Then
   Cells(x, 1).EntireRow.Delete
End If
Next x

 

 

Mens det jeg prøver på er at disse verdiene står i et eget ark og bruker det som referanse i koden

Dim MyRange As Range
Dim x As Long
Dim MyLastRow As Long
Set MyRange = Intersect(ActiveSheet.UsedRange, Range("A:A"))
   MyLastRow = MyRange.Row + MyRange.Rows.Count - 1

For x = MyLastRow To 11 Step -1
If Cells(x, 1).Value = False Or Cells(x, 1).Value = Sheets("ver").Range("e1") Then
   Cells(x, 1).EntireRow.Delete
End If
Next x

 

Men det fungerer ikke, noen som vet hvorfor?

 

Hilsen

 

Torbjørn

Lenke til kommentar

Videoannonse

Videoannonse
Annonse
Harald Staff

Harald Staff

Skrevet
Skrevet

Ingenting som springer i øynene her. "Fungerer ikke" er også litt vagt. Du har sjekket at MyLastRow stemmer med virkeligheten og at innholdet cellene imellom har eksakt samme verdi, ikke mellomrom før eller etter og sånt skit?

 

Sett

Option Explicit

øverst i modulen (alltid, overalt), og

On Error Goto 0

tidlig i makroen, kjør igjen og se om noe feiler.

 

Rett opp til Sheets("ver").Range("E1").VALUE også for ordens skyld.

 

Beste hilsen Harald

Lenke til kommentar
Bigelk

Bigelk

Skrevet
  • Forfatter
Skrevet

Hei.

 

Da var den løst.

(Det her blir flaut)

Løsning:

Arket var scrollet ned så jeg skrev verdien i celle E20 i stede for E1 :)

 

Men nå har jo problemstilling nr 2 dukker opp.

 

Jeg har mer enn en verdi, så Range E1 til E20 blir da fylt inn med de verdiene som skal sjekkes opp.

Dim MyRange As Range
Dim x As Long
Dim MyLastRow As Long
Set MyRange = Intersect(ActiveSheet.UsedRange, Range("A:A"))
   MyLastRow = MyRange.Row + MyRange.Rows.Count - 1

For x = MyLastRow To 11 Step -1
If Cells(x, 1).Value = False Or Cells(x, 1).Value = Sheets("ver").Cells(1, 5).Value Or Sheets("ver").Cells(2, 5).Value Then
   Cells(x, 1).EntireRow.Delete
End If
Next x

 

Får runtime error 13 type missmatch.

prøvde og refere til en annen range som ikke er fylt inn med noenting, da kommer det ikke opp noen feilmld.

Så feilmld kommer bare når jeg referer til en range som er fylt inn?

 

Har også prøvd

Dim MyRange As Range
Dim x As Long
Dim MyLastRow As Long
Dim R As Range
Set MyRange = Intersect(ActiveSheet.UsedRange, Range("A:A"))
   MyLastRow = MyRange.Row + MyRange.Rows.Count - 1
Set R = Range("e1:e20")

For x = MyLastRow To 1 Step -1
If Cells(x, 1).Value = False Or Cells(x, 1).Value = R Then
   Cells(x, 1).EntireRow.Delete
End If
Next x

 

Men det fungerer ikke i det hele tatt (runtime error 13)

Hilsen

 

Torbjørn

Lenke til kommentar
Harald Staff

Harald Staff

Skrevet
Skrevet

Dette går jo ikke:

 

If Cells(x, 1).Value = False Or Cells(x, 1).Value = Sheets("ver").Cells(1, 5).Value Or Sheets("ver").Cells(2, 5).Value Then

 

I neste forsøk har du trøbbel. Du har vent deg til at dette fungerer:

 

If Cells(x, 1).Value = Sheets("ver").Range("e1")

 

Sheets("ver").Range("e1") er en range bestående av en enkelt celle. VBA returnerer da default property som er .value (det kunne like gjerne vært adresse, fontnavn, bakgrunnsfarge, datatype, ...)

Når du deklarerer en variabel til å være Range, får du ikke den samme hjelpen, du må spesifisere .value. Og så; en range bestående av flere celler har ikke en enkelt .value og koden feiler.

 

Det du må gjøre her er et søk i R og se om verdien finnes. Dette gjør du best i en separat funksjon. La meg hjelpe deg på vei:

 

Private Function Funnet(Hva As Variant) As Boolean

Dim R As Range, Funn As Range

Set R = Sheets("ver").Range("E1:E20")

On Error Resume Next

Set Funn = R.Find(what:=Hva)

Funnet = Not (Funn Is Nothing)

End Function



Sub test()

If Funnet(Cells(4, 1).Value) Then

'action

End If

End Sub

 

Beste hilsen Harald

Lenke til kommentar
Bigelk

Bigelk

Skrevet
  • Forfatter
Skrevet (endret)

Hei.

 

Beklager at jeg bruker opp tiden deres på slurvefeil.

 

Dim MyRange As Range 
Dim x As Long 
Dim MyLastRow As Long 
Set MyRange = Intersect(ActiveSheet.UsedRange, Range("A:A")) 
   MyLastRow = MyRange.Row + MyRange.Rows.Count - 1 

For x = MyLastRow To 11 Step -1 
If Cells(x, 1).Value = False Or Cells(x, 1).Value = Sheets("ver").Cells(1, 5).Value _
Or Cells(x, 1).Value =  Sheets("ver").Cells(2, 5).Value Then 
   Cells(x, 1).EntireRow.Delete 
End If 
Next x

 

Jeg hadde glemt "cells(x, 1).value =" etter Or

 

Men jeg lurer fortsatt på om det går ann å deklarere en range?

 

dim r as range
set r = range("E1:E20")
If Cells(x, 1).Value = False Or Cells(x, 1).Value = R Then
  Cells(x, 1).EntireRow.Delete

 

Hilsen

 

Torbjørn

Endret av Bigelk
Lenke til kommentar
Bigelk

Bigelk

Skrevet
  • Forfatter
Skrevet (endret)

Hei.

 

Beklager Harald, jeg så ikke svaret ditt. Trenger en god dose kaffe tror jeg :)

 

Takk for hjelpen :)

 

Men jeg har aldri brukt Private Function før.

skal dette skrives før Sub?

 

Modulen min inneholder litt mer enn bare "ekskluderings fasen" så jeg vet ikke helt hvordan jeg skal få "modifisert" inn koden din.

 

Her er hele modulen min

Sub knapp83_klikk()
'Knapp Generer. importerer Kg og tid. Generer Plukkstatistikk ut i fra informasjonen som har blitt importert inn
Application.ScreenUpdating = False

'Åpner opp vindu så du kan velge hvilken tekst fil du vil importere
Sheets(1).Select
ActiveSheet.Select
   Dim IntPath$, project$, pickf As Object
       IntPath = "//filserver/tope/plukk"
   Set pickf = Application.FileDialog(msoFileDialogFilePicker)
   With pickf
       .InitialView = msoFileDialogViewDetails: .InitialFileName = IntPath: .Filters.Clear: .Filters.Add "Pick .txt File", "*.txt", 1: .ButtonName = "Import file": .Title = "Search for .txt file to Import"
       If .Show = -1 Then
           project = .SelectedItems(1)
           Else: GoTo SubExit
       End If
   End With
Range("A2:AZ500").ClearContents
   With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
       & project, Destination:=Range("A1"))
       .RefreshStyle = xlInsertDeleteCells
       .Refresh BackgroundQuery:=False
   End With

'Sorterer Dataen som er importert inn i det nye Arket, og limer det inn i Ark Olfi.
Columns("a:a").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
   FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(44, 1), Array(45, 1), Array(55, 1), _
   Array(58, 1), Array(70, 1), Array(77, 1)), TrailingMinusNumbers:=True

'ekskluderer de som ikke skal være med i plukkstatistikken
Dim MyRange As Range
Dim x As Long
Dim MyLastRow As Long
Set MyRange = Intersect(ActiveSheet.UsedRange, Range("A:A"))
   MyLastRow = MyRange.Row + MyRange.Rows.Count - 1

For x = MyLastRow To 1 Step -1
If Cells(x, 1).Value = False Or Cells(x, 1).Value = Sheets(3).Cells(1, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(2, 5).Value _
   Or Cells(x, 1).Value = Sheets(3).Cells(3, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(4, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(5, 5).Value _
   Or Cells(x, 1).Value = Sheets(3).Cells(6, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(7, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(8, 5).Value _
   Or Cells(x, 1).Value = Sheets(3).Cells(9, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(10, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(11, 5).Value _
   Or Cells(x, 1).Value = Sheets(3).Cells(12, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(13, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(14, 5).Value _
   Or Cells(x, 1).Value = Sheets(3).Cells(15, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(16, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(17, 5).Value _
   Or Cells(x, 1).Value = Sheets(3).Cells(18, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(19, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(20, 5).Value Then
   Cells(x, 1).EntireRow.Delete
End If
Next x

Range("a1").Select
Do Until IsEmpty(ActiveCell)
   ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-2, 0).Select
Do Until IsEmpty(ActiveCell)
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   ActiveCell.Offset(0, 1).Select
Loop

'Åpner opp vindu så du kan velge hvilken xls fil du vil importere
Sheets(2).Select
ActiveSheet.Select
   Dim IntPath2$, project2$, pickf2 As Object
       IntPath2 = "//filserver/tope/plukk"
   Set pickf2 = Application.FileDialog(msoFileDialogFilePicker)
   With pickf2
       .InitialView = msoFileDialogViewDetails: .InitialFileName = IntPath: .Filters.Clear: .Filters.Add "Pick .xls File", "*.xls", 1: .ButtonName = "Import file": .Title = "Search for .xls file to Import"
       If .Show = -1 Then
           project2 = .SelectedItems(1)
           Else: GoTo SubExit
       End If
   End With
Range("A2:AZ500").ClearContents
   With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
       & project2, Destination:=Range("A1"))
       .RefreshStyle = xlInsertDeleteCells
       .Refresh BackgroundQuery:=False
   End With


'Sorterer Dataen som er importert inn i det nye Arket, og limer det inn i Ark Wintid.
   Columns("B:B").Select
   Selection.ClearContents
   Columns("A:A").Select
   Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
      FieldInfo:=Array(Array(0, 1), Array(7, 1)), TrailingMinusNumbers:=True

'generer
Sheets("plukk").Select
Range("b4").Select
   Dim f As Integer
   Dim fntRowCount As Integer
       fntRowCount = Sheets("olfi").Range("A1").CurrentRegion.Rows.Count - 0
   For f = 1 To fntRowCount
       ActiveCell.FormulaR1C1 = "='olfi'!R[-3]C[-1]" 'Kolonne B
       ActiveCell.Offset(0, 1).Select
       ActiveCell.FormulaR1C1 = "='olfi'!R[-3]C[-1]" 'kolonne C
       ActiveCell.Offset(0, 2).Select
       ActiveCell.FormulaR1C1 = "='olfi'!R[-3]C[-1]" 'Kolonne E
       ActiveCell.Offset(0, 2).Select
       ActiveCell.FormulaR1C1 = "='olfi'!R[-3]C[-1]" 'Kolonne G
       ActiveCell.Offset(0, 2).Select
       ActiveCell.FormulaR1C1 = "='olfi'!R[-3]C[-1]" 'kolonne I
       ActiveCell.Offset(0, -7).Select
       ActiveCell.Offset(1, 0).Select
   Next f

'Setter inn formelen Finn.Rad i Kolonne A og D i fane Plukk. Den bruker Initialene for og finne Ansatt nr _
ved og bruke verifiseringslisten
'Setter inn Formel Delt på i kolonne F,H,J,K,L og M
'I celle Y4 har jeg formelen tellblanke som jeg bruker som referanse
Sheets("plukk").Select
Range("A4").Select
   Dim y As Integer
   y = 41 - Cells(4, 25)
   Dim l As Integer
   For l = 1 To y
       ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[1],'ver'!R1C:R96C[1],2,)" 'Kolonne A
       ActiveCell.Offset(0, 3).Select
       ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Wintid!R6C1:R[196]C[22],3,)" 'kolonne D
       ActiveCell.Offset(0, 2).Select
       ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-2]" 'kolonne F
       ActiveCell.Offset(0, 2).Select
       ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-4]" 'Kolonne H
       ActiveCell.Offset(0, 2).Select
       ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-6]" 'kolonne J
       ActiveCell.Offset(0, 1).Select
       ActiveCell.FormulaR1C1 = "=RC[-6]/RC[-4]" 'Kolonne K
       ActiveCell.Offset(0, 1).Select
       ActiveCell.FormulaR1C1 = "=RC[-7]/RC[-3]" 'kolonne L
       ActiveCell.Offset(0, 1).Select
       ActiveCell.FormulaR1C1 = "=RC[-6]/RC[-4]" 'kolonne M
       ActiveCell.Offset(0, -12).Select
       ActiveCell.Offset(1, 0).Select
   Next l

Range("A2").Select
   ActiveCell.FormulaR1C1 = "=VLOOKUP(""sum"",Olfi!R[-1]C:R[198]C[25],2,)"

SubExit:
Sheets(4).Select
Exit Sub

Application.ScreenUpdating = True
End Sub

 

Hilsen

 

Torbjørn

Endret av Bigelk
Lenke til kommentar
Harald Staff

Harald Staff

Skrevet
Skrevet

En Function er en frittstående Sub som returnerer en verdi. Eller mer korrekt, en Sub er en Function som returnerer ignenting (kalt Void i mange språk). Hvis den er Private må den stå i samme modul som Sub'ene som bruker den, hvorsomhelst, for seg selv utenfor Sub'ene. Viktigste grunnen til å merke den Private er at den da ikke kan brukes som regnearkformel.

 

Funksjonen erstatter hele den forferdelige

 

If Cells(x, 1).Value = False Or Cells(x, 1).Value = Sheets(3).Cells(1, 5).Value Or Cells(x, 1).Value = Sheets(3).Cells(2, 5).Value osv osv osv-setningen, slik:

If Funnet(Cells(x, 1).Value) Then

Cells(x, 1).EntireRow.Delete 

End if

Lenke til kommentar

Opprett en konto eller logg inn for å kommentere

Du må være et medlem for å kunne skrive en kommentar

Opprett konto

Det er enkelt å melde seg inn for å starte en ny konto!

Start en konto

Logg inn

Har du allerede en konto? Logg inn her.

Logg inn nå
Gå til emneliste

  • Hvem er aktive   0 medlemmer

    • Ingen innloggede medlemmer aktive
×
×
  • Opprett ny...