Slet celler med makro

Det vil være mere "smart" hvis eksempel:

Hvis c97 til c99 skal slettes, så marker jeg c97 til c99 og makroen rykker c100 til c375 3 rækker op.

Mvh.  Knud Evendorff

Er det noget i denne stil du ønsker?

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Row < 85 Or Target.Row > 375 Or Target.Column <> 3 Then
MsgBox ("Slet-tekst-markering mangler")
Else
x = Target.Rows.Count - 1
y = Target.Row
If x = 0 Then
MsgBox ("Slet celle C" & y)
Else
MsgBox ("Slet cellerne C" & y & " til C" & y + x)
End If
Range(Cells(y, 3), Cells(y + x, 3)).Delete
End If
End Sub

Tak for forslag.

Som jeg læser det, så er det fast 3 celler. Det jeg mener er, at det antal celler jeg marker over 1,2,3 eller flere skal slettes, og efterfølgende rækker i kol. c rykkes op til den den først markerede. Men en løsning med kun en markeret celle kan også bruges, således at hvis flere celler efter hinanden skal slettes, så køres makroen så flere gange.

Jeg har sat din kode ind således:


Sub RykPosition()

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Row < 85 Or Target.Row > 375 Or Target.Column <> 3 Then
MsgBox ("Slet-tekst-markering mangler")
Else
x = Target.Rows.Count - 1
y = Target.Row
If x = 0 Then
MsgBox ("Slet celle C" & y)
Else
MsgBox ("Slet cellerne C" & y & " til C" & y + x)
End If
Range(Cells(y, 3), Cells(y + x, 3)).Delete
End If
End Sub

End Sub


Det giver fejlen : mangler end sub.

mvh

Knud evendorff

Tak for forslag.

Som jeg læser det, så er det fast 3 celler. Det jeg mener er, at det antal celler jeg marker over 1,2,3 eller flere skal slettes, og efterfølgende rækker i kol. c rykkes op til den den først markerede. Men en løsning med kun en markeret celle kan også bruges, således at hvis flere celler efter hinanden skal slettes, så køres makroen så flere gange.

Jeg har sat din kode ind således:


Sub RykPosition()

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Row < 85 Or Target.Row > 375 Or Target.Column <> 3 Then
MsgBox ("Slet-tekst-markering mangler")
Else
x = Target.Rows.Count - 1
y = Target.Row
If x = 0 Then
MsgBox ("Slet celle C" & y)
Else
MsgBox ("Slet cellerne C" & y & " til C" & y + x)
End If
Range(Cells(y, 3), Cells(y + x, 3)).Delete
End If
End Sub

End Sub


Det giver fejlen : mangler end sub.

mvh

Knud evendorff

Nej, du skal tage min makro som den er, højreklikke på fanebladet, vælge vis koder og indsætte den der.
Den sletter de celler du markerer i området C85:C375, uanset hvor mange celler du markerer. Og den kører automatisk, når du har markeret et område. Hvis du ikke vil have den til at køre automatisk skal den se således ud:

Sub RykPosition()
If Selection.Row < 85 Or Selection.Row > 375 Or Selection.Column <> 3 Then
MsgBox ("Slet-tekst-markering mangler")
Else
x = Selection.Rows.Count - 1
y = Selection.Row
If x = 0 Then
MsgBox ("Slet celle C" & y)
Else
MsgBox ("Slet cellerne C" & y & " til C" & y + x)
End If
Range(Cells(y, 3), Cells(y + x, 3)).Delete
End If
End Sub

Så er vi i den rigtige retning :

Når der er markeret uden for området så får jeg fejlen - altså OK

Det skal bemærkes, at i kol. D til G der indgår tekster fra kol. C - disse  beregningskol. bliver smadret (#:REFFERENCER), når jeg sletter linier.


Når jeg sletter en linie (altså kun marker en celle) så flyttes korrekt en linie op, men kodningen i kol. D til G smadres.

Hvis jeg sletter mere end en linie, så rykkes der ikke op, og beregningsceller til højre bliver rundtosset.

mvh

Knud Evendorff

Oplysning om hvad jeg har stående i C85 til C375.

Jeg copy/paster varelinier fra indkøbsportal <etilbudsavis.dk> ind i mit ark. Der kan være linier, jeg ønsker at slette efterfølgende.

eks. på linier:

Iceberg salat 1
Kl. I, spansk Pr.stk.
REMA 1000 9,00 kr. 13/03/2016&#8208;19/03/2016
Smagfuld hakket dansk okse&#8208;, skinke&#8208;, svine&#8208; og kalvekød eller kyllingekød 1
3&#8208;7% 400&#8208;450 g. Max 62,50 pr. kg. 3&#8208;7%. FEDT.
REMA 1000 25,00 kr. 400&#8208;450 g &#64830;max 62,50 kr./kg&#64831; 13/03/2016&#8208;19/03/2016
Friland økologiske koteletter, flæsk i skiver eller medister 1
Max 100,00 pr. kg. 250&#8208;350 g
REMA 1000 25,00 kr. 250&#8208;350 g &#64830;max 100,00 kr./kg&#64831; 13/03/2016&#8208;19/03/2016
Lammefjords kartofler Danske 1
1,5 kg. 3,33 pr. kg
REMA 1000 5,00 kr. 1,5 kg &#64830;3,33 kr./kg&#64831; 13/03/2016&#8208;19/03/2016
Lammekølle Uden nøgleben 1
1,3&#8208;1,6 kg. Max. 60,77 pr. kg. Dybfrost.

Disse linier manipuleres i kol. D til P (ikke som før skrevet G)
så jeg har en fornuftig tekst, som kun fylder en linie (række) pr. vare.

Det er ganske logisk at du får (#:REFFERENCER) når celler der refereres til fjernes. Jeg ser to løsningsmuligheder:
1. Du sletter hele linien
2. Du sletter kun indhold

Løsning 1:

Sub RykPosition()
If Selection.Row < 85 Or Selection.Row > 375 Or Selection.Column <> 3 Then
MsgBox ("Slet-tekst-markering mangler")
Else
x = Selection.Rows.Count - 1
y = Selection.Row
If x = 0 Then
MsgBox ("Slet række " & y)
Else
MsgBox ("Slet rækkerne " & y & " til " & y + x)
End If
Range(Cells(y, 3), Cells(y + x, 3)).EntireRow.Delete
End If
End Sub

Løsning 2:

Sub RykPosition()
If Selection.Row < 85 Or Selection.Row > 375 Or Selection.Column <> 3 Then
MsgBox ("Slet-tekst-markering mangler")
Else
x = Selection.Rows.Count - 1
y = Selection.Row
If x = 0 Then
MsgBox ("Ryd celle C" & y)
Else
MsgBox ("Ryd cellerne C" & y & " til C" & y + x)
End If
Range(Cells(y, 3), Cells(y + x, 3)).ClearContents
End If
End Sub

Svar løsning 1
For hvergang jeg sletter med den løsning vil jeg vel miste de nederste programlinier, og det går vel kun en vej - mod nul.

Svar løsning 2.
Jeg kan ikke bruge tomme celler. Efterfølgende celler i kol. C skal rykkes op.

Jeg har tidligere lavet (indspillet) makro, som bruger copy/paste, men den virker kun for sletning af den første celle C85.
Kan den tilrettes, så den virker med udgangspunkt i de celler jeg marker?

min egen 1/4 løsning.

Sub RykEnPositionOp()
'
' RykEnPositionOp Makro
' Makro indspillet 23-03-2015 af bruger

    ActiveSheet.Unprotect
    Range("C86:C375").Select
    Range("C375").Activate
    Selection.Copy
    Range("C85").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
 
      ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Da du ikke kan bruge løsning 2 ser jeg igen to muligheder:
a. Du sletter cellen, og bruger indirect funktion for at undgå #REF
b. Du sletter hele linien efter at have tilføjet ekstra linier nederst  (fra linie 376).

a: Brug denne makro:

Sub RykPosition()
If Selection.Row < 85 Or Selection.Row > 375 Or Selection.Column <> 3 Then
MsgBox ("Slet-tekst-markering mangler")
Else
x = Selection.Rows.Count - 1
y = Selection.Row
If x = 0 Then
MsgBox ("Slet celle C" & y)
Else
MsgBox ("Slet cellerne C" & y & " til C" & y + x)
End If
Range(Cells(y, 3), Cells(y + x, 3)).Delete Shift:=xlUp
End If
End Sub

Og i de celler, hvor der refereres til kolonne C bruges:
=INDIRECT("C"&ROW())

Dansk: =INDIREKTE("C"&RÆKKE())


b: Brug denne makro:

Sub RykPosition()
If Selection.Row < 85 Or Selection.Row > 375 Or Selection.Column <> 3 Then
MsgBox ("Slet-tekst-markering mangler")
Else
x = Selection.Rows.Count - 1
y = Selection.Row
If x = 0 Then
MsgBox ("Slet række " & y)
Else
MsgBox ("Slet rækkerne " & y & " til " & y + x)
End If
Rows(375).Copy Destination:=Range(Cells(376, 1), Cells(376 + x, 1))
Range(Cells(y, 3), Cells(y + x, 3)).EntireRow.Delete
End If
End Sub

Tak for forslag.

Forslag 1: forstår jeg ikke. Jeg kender udmærket func. indirekte, men kender ikke syntaksen, for at sætte det ind i VBA koden.

Forslag 2: virker perfekt, men, men i min løsning ikke. Fordi de tekster jeg loader, er karakteriseret ved, at jeg skal teste op til 6 linier (nedad), førend jeg har de oplysninger, jeg skal bruge til at danne en varelinie : tekst,pris og antal.

Spørgsmål : Hvorfor kan min 1/4 løsning ikke bruges. Jeg har forsøgt at bruge noget af din kode sammen med min copy/paste - men uden noget held.

mvh

Knud Evendorff

Læs lige mit forslag igen. Indirekte funktionen skal sættes ind i cellerne, ikke i VBA.

Kan du vise hele din kode?

Undskyld min svartid. Jeg havde ingen mail, om at der var svar/kommentar.

Jeg har brugt forslag 1 som fungerer.

Med mange tak og venlig hilsen

Knud Evendorff

Vil du kvitter med et svar

Godt. Du får et svar