Makro der indsætter formler

Hej JonathanW

Hvordan ønsker du at starte din makro fra kolonne E ??
Og hvilken version af Excel har du ???

mvh Nicolai

Hej Nicolai,

Excel 2000 - dansk !

Det skal bruges til en laaang todo liste, hvor den første celle der er aktiv er i kol. E. Når en opgave er done sletter jeg rækken og på et tidspunkt skal jeg sætte nye rækker ind, typisk 5 rækker.

Nogle af cellerne er tomme, til manuelle indtastninger og andre skal der være formler i.

Bevarer det dit spørgsmål ?

M.v.h. Jonathan

Hej JonathanW

Er ikke sikker på, hvad du helt nøjagtig ønsker ?
Skal makroen kun virke på en enkelt rækker ?? eller er det hele kolonne E med samtlige rækker udaf ??

Anyway ...

For eksemplets skyld har jeg oprettet en kommandoknap (cmdIndsætformler) på Sheet1, med tilhørende kode, som ta´r udgangspunkt i celle "E1". Koden indsætter mine test-formler i cellerne 5, 7 og 9 til højre for celle "E1".

Kode bag knappens Click_hændelse ser således ud:


Private Sub cmdIndsætformler_Click()
   
 
'sæt Excel´s opdatering ud af kraft
Application.ScreenUpdating = False

   

    Range("E1").Select
    ActiveCell.Offset(0, 5).Value = "=SUM(A1)"

    Range("E1").Select
    ActiveCell.Offset(0, 7).Value = "=SUM(B1)"

    Range("E1").Select
    ActiveCell.Offset(0, 9).Value = "=SUM(C1)"
   


'slå Excel´s opdatering til igen
Application.ScreenUpdating = True


End Sub




Mvh Nicolai

Hej Nicolai,

Tak for din indsats. Dine koder har den ulempe, at de handler om E1 og kun E1. Så det strander jeg på.

Jeg har nu lavet et test-ark i Excel, med kort instruktion, så du, og evt. andre interesserede, kan se hvad opgaven går ud 'in action' og lave en makro på dette ark og returnere det til mig.

Jeg har Excel 2000 på dansk.

Hvis du er interesseret, så send mail til: jonathan.weidinger@gmail.com.

På forhånd tak.

Hej Jonathan

Det er såmænd bevidst, at mine koder "kun" handler om Celle E i række 1 ... Det var jo bare et skud i tågen og mest af alt for princippets skyld i forhold til at kopiere koder!

Hvis du ikke har fået løst dit "problem"?, må du gerne maile dit test ark til mig på nicolaifogt@gmail.com ... så skal jeg se, hvad jeg kan gøre ???

Mvh Nicolai

Hej Nicolai,

Fint, jeg sender det med det samme.

M.v.h.

Jonathan

Jeg har nu over mail fået hjælp fra Nicolai og lukker hermed dette spørgsmål.

Hej Jonathan

For go´ ordens skyld og brugerne på Eksperten.dk, kommer koden her.

Private Sub cmdIndsæt5Rækker_Click()

'erklæring af variabler ...
Dim y As Integer            'det aktive rækkenummer
Dim x As Integer            'det aktive kolonnenummer
Dim sBogstav As String      'det aktive kolonne bogstav
Dim r As Integer            'rækkenummeret på den sidste række med data/formler
Dim ecell As String        'cellekoordinat i kolonne E
Dim icell As String        'cellekoordinat i kolonne I
Dim eicellrange As String  'det samlede cellekoordinat (range) fra kolonne E til I



'sæt Excel´s opdatering ud af kraft
Application.ScreenUpdating = False


'tildel y og x, række og kolonne numre
y = ActiveCell.Row
x = ActiveCell.Column

'lav kolonne nummeret om til et bogstav
sBogstav = Replace(ActiveSheet.Cells(y, x).Address(False, False), y, "")






'tildel variablen r, rækkenummeret på sidste række indeholdende data
r = ActiveSheet.Range("M65536").End(xlUp).Row



'hvis den aktive celle er i kolonne E, skal der indsættes nye rækker!
If sBogstav = "E" Then

    'tjek, hvor den aktive rækker ligger i forhold til det lysegrønne indtastningsområde
    Select Case y
   
   
       
        'hvis den aktive celle i kolonne E ... er i den sidste række
        Case Is = r
       

                       
            'løb gennem løkken 4 gange
            For t = 1 To 4
               
                'indsæt ny række ... før den aktive række!
                Rows(y).Insert
           
            Next
           
           
            'flyt focus 4 rækker ned og vælg cellen (gør den til den aktive celle)
            ActiveCell.Offset(4, 0).Select

            'tildel variablen r, rækkenummeret på sidste række indeholdende data
            r = ActiveSheet.Range("M65536").End(xlUp).Row

            'cellekoordinat i kolonne E
            ecell = "E" & r
           
            'cellekoordinat i kolonne I
            icell = "I" & r

            'samlede cellekoordinat (range) fra kolonne E til I
            eicellrange = ecell & ":" & icell
   
            'vælg det samlede cellekoordinat (range)
            Range(eicellrange).Select
           
            'kopier celleværdier i det samlede cellekoordinat (range)
            Selection.Copy
           
           
            'flyt focus 4 rækker op og vælg cellen (gør den til den aktive celle)
            ActiveCell.Offset(-4, 0).Select
           
            'indsæt de kopierede værdier
            ActiveSheet.Paste
           
            'vælg det samlede cellekoordinat (range) ... i sidste række!!!
            Range(eicellrange).Select
           
            'tøm celleværdier i det samlede cellekoordinat (range) ... i sidste række!!!
            Selection.Value = ""
           
            'flyt focus 4 rækker op til cellen, hvor det hele startede ...
            ActiveCell.Offset(-4, 0).Select
         
         
         
      'hvis den aktive celle i kolonne E ... ligger før den første række
        Case Is < 6

   
            MsgBox "Den valgte celle ligger udenfor det lysegrønne område!", vbInformation
       
     
     
        'hvis den aktive celle i kolonne E ... ligger efter den sidste række
        Case Is > r

   
            MsgBox "Den valgte celle ligger udenfor det lysegrønne område!", vbInformation
           
           
           
        'hvis den aktive celle ligger indenfor den lysegrønne område ... og det IKKE er i den sidste række
        Case Else
           

            'løb gennem løkken 4 gange
            For t = 1 To 4
   
                'indsæt ny række efter den aktive række
                Rows(y + 1).Insert
            Next
   
   
   
    End Select
   



    'tildel variablen r, rækkenummeret på sidste række indeholdende data
    r = ActiveSheet.Range("M65536").End(xlUp).Row

       


    'træk formler med ned i de 5 nye rækker i kolonnerne J og M
    Worksheets("Ark1").Range("J6:M" & r).FillDown

    'træk formler med ned i de 5 nye rækker i kolonnerne B og C
    Worksheets("Ark1").Range("B6:C" & r).FillDown



    'Sørg for at de to øverste hvide Ref celler i kolonne D har værdien 1 og 2
    'ellers vil koden ikke "Autofill´e" kolonne D med fortløbende numre
   
    'hvis celle D6 er tom, så sæt D6 = 1
    If Range("D6").Value = "" Then Me.Range("D6").Value = 1
   
    'hvis celle D7 er tom, så sæt D7 = 2
    If Range("D7").Value = "" Then Range("D7").Value = 2



    'træk fortløbende Ref tal med ned i de 5 nye rækker i kolonne D
    Set SourceRange = Worksheets("Ark1").Range("D6:D7")
    Set fillRange = Worksheets("Ark1").Range("D6:D" & r)
    SourceRange.AutoFill Destination:=fillRange


    'fjern Excel´s kopieringsmarkering
    Application.CutCopyMode = False



'hvis den aktive celle IKKE er i kolonne E!
Else


    MsgBox "Den valgte celle ligger udenfor kolonne E!", vbInformation



End If
 
 
 

'slå Excel´s opdatering til igen
Application.ScreenUpdating = True



End Sub



Med venlig hilsen, Nicolai

Hej Nicolai,

Fint !

Med venlig hilsen

Jonathan

Undskyld at denne tråd ikke blev lukket. Jeg har givet Nicolai 150 point andetsteds for hjælp over mail. NU lukkes den

Husk at acceptere dit eget svar......

MANGE TAK, for din vejledning, Vejmand. Nu har jeg skrevet det ned.