Jeg har et spørgsmål vedr. makroer i Excel. Jeg er ret grøn på området indenfor makroer, men dog ikke vedr. bruger af Excel generelt.
Mit spørgsmål går ud på, hvordan jeg får oprettet en makro der kan gøre følgende:
Jeg har et Excel-dokument, heri vil jeg oprette en makro som skal gøre noget på et ark, jeg kopier ind i det her dokument. Arket der kopieres ind er forskelligt fra gang til gang, altså data mængden og antallet af rækker varierer.
Så hvordan får jeg lavet en makro der automatisk tilpasser sig datamængden?
Jeg skal nemlig kopiere noget ned i bunden, men da antal rækker varierer, så passer min makro ikke, og kopierer derfor data ned forbi den nederste linje.
Jeg tror du kan skrive det ned til dette. Det kan være det er bedst at se et eksempel på dataen du manipulerer.
Sub Test() ' Test Makro Rows("1:6").Select 'skriv evt 7 hvis det skal endnu en linje ned Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("K11").Select ActiveCell.FormulaR1C1 = "Saldo" Range("K12").Select ActiveCell.FormulaR1C1 = "=RC[-1]" Range("K13").Select ActiveCell.FormulaR1C1 = "=RC[-1]+R[-1]C" Range("K14").Select ActiveCell.FormulaR1C1 = "=R[-1]C+RC[-1]"
Range("I206").Select ActiveCell.FormulaR1C1 = "Rest" End Sub
Det ser ud til at du kopierer nogen fra K13 og K14 ned på ca 200 rækker, er det bevidst, eller er det her vi kun skal kopiere så langt som der er data?
Er det vigtigt at du indsætter linjer øverst, det er ret mange du sætter ind?
Kan du prøve at beskrive med ord hvad du har brug for?
Det er meningen, at der i toppen skal indsættes 10 linjer :-)
Det jeg forsøger, at få en makro til er, at jeg står i Excel-dokument 1 på ark 1. Jeg har så kopieret et ark ind fra mit Excel-dokument 2, som så ligger før mit ark 1.
Jeg vil så starte på mit ark 1 og herefter gå ind på det ark jeg har kopieret ind. Her skal der indsættes 10 linjer. Celle J11 skal så kopieres over i celle K11, hvorefter der skrives en tekst i celle K11. Herefter stiller jeg mig i K12, hvor jeg skriver "=J12" og trykker enter. Herefter trykker jeg på celle K13 og skriver "=K12+J13" og trykker enter. Så trykker jeg en enkelt gang på K12, hvorefter jeg trykker på den lille firkant nederst i højre hjørne, så den kører ned til sidst mulige celle. Herefter skal den så gøre noget mere.
Men mit spørgsmål er: Kan jeg få makroen til selv at finde ud af, hvor langt den skal kopiere formlen ned?
Antallet af rækker med data varierer nemlig for gang til gang, og den makro jeg har lavet nu er lavet ud fra det antal rækker jeg havde i det pågældende ark jeg har kopieret over.
Det kan sagtens lade sig gøre, det kræver blot at du har en kolonne som har tekst ned til der hvor du vil kopiere, så kan man lave en variabel som tæller hvilken række det er, og bruge den til kopiering.
Jeg forstår dog ikke hvorfor du vil kopiere J11 over i K11 inden du overskriver hvad du kopierede med en tekst?
Jeg vil prøve imorgen at lave en lidt mere skarp makro til dig ud fra det du beskriver.
Her er en lidt mere sammenskrevet løsning: Sub test()
' variable der skal bruges Dim KopieretSheet As String Dim OriginalSheet As String Dim LastRow As Integer
' sætter variable for at have nemmere ved at "kalde" dem i videre proces OriginalSheet = ThisWorkbook.ActiveSheet.Name KopieretSheet = ThisWorkbook.Sheets(1).Name
' kopier celle J11 over i K11 og sæt navn i K11 Range("J11").Select ' jeg tror denne linje er overflødig Selection.AutoFill Destination:=Range("J11:K11"), Type:=xlFillDefault ' jeg tror denne linje er overflødig Range("J11:K11").Select ' jeg tror denne linje er overflødig Range("K11").Select ActiveCell.FormulaR1C1 = "Saldo" ' de to forgående kan skrives sammen til: ThisWorkbook.Sheets(KopieretSheet).Range("K11").FormulaR1C1 = "Saldo"
' skriv diverse formler ThisWorkbook.Sheets(KopieretSheet).Range("K12").FormulaR1C1 = "=RC[-1]" ThisWorkbook.Sheets(KopieretSheet).Range("K13").FormulaR1C1 = "=RC[-1]+R[-1]C"
' Angiv hvor langt ned der skal kopieres LastRow = Range("A15").SpecialCells(xlLastCell).Row ThisWorkbook.Sheets(KopieretSheet).Range("K13").Select Selection.AutoFill Destination:=Range("K14:K" & LastRow)
End Sub
Bemærk der kan være noget med fanerne du skal have styr på, men nu tæller den sidste række ved at se på sidste celle i kolonne A.
Det er ligemeget for mig om noget kan skrives kortere, det vigtigste som jeg mangler til min formel det er det du beskrev til sidst i den formel du sendte, at den skal tage udgangspunkt i kolonne A, hvor den så tæller sidste række. Til sidst skal jeg så ind og tilføje noget tekst i kolonne I men sidste række - det ved jeg heller ikke om man kan få den automatisk til? Kan den måske tage udgangspunkt i at den sidste linje har en farve?
Alternativt kan jeg sende en illustration af, hvordan data ser ud inden jeg kopierer det over, og så vise, hvordan jeg gerne vil have det skal se ud? Hvis det hjælper?
'Fylder J11 ned til K11 Range("J11").Select Selection.AutoFill Destination:=Range("J11:K11"), Type:=xlFillDefault
'Skriver tekst og formler Range("K11").Formula = "Saldo" Range("K12").Formula = "=J12" Range("K13").Formula = "=K12+J13"
'Finder sidste række under J13 SidsteRækkeKolonneK = Range("J13").End(xlDown).Row 'Fylder K13 ned til sidste række under J13 Range("K13").Select Selection.AutoFill Destination:=Range("K13:K" & SidsteRækkeKolonneK)
'Fylder J132 ud til K132 Range("J132").Select Selection.AutoFill Destination:=Range("J132:K132"), Type:=xlFillDefault
'Sletter K132 Range("K132").Formula = "" 'Skriver tekst i I132 Range("I132").Formula = "Restbeløb"
Sheets("Ark1").Select End Sub
"Alternativt kan jeg sende en illustration af, hvordan data ser ud inden jeg kopierer det over, og så vise, hvordan jeg gerne vil have det skal se ud? Hvis det hjælper?" Det ville hjælpe meget. Brug evt. Dropbox.
Den kopierer min formel ned til sidste linje lige præcis som jeg har ønsket - så TAK indtil videre.
Dog fungerer det med at skrive "Restbeløb", kopier den sidste celle i kolonne J over i kolonne K og slette indholdet i cellen ikke helt.
Min sidste linje i arket er en farvet linje, hvor "A-J" er farvet. I "J" står et beløb. I "I" skal der så stå "Restbeløb". "K" skal farves med samme farve som "A-J", men skal være tomt.
Giver det mening, eller er det nødvendigt at se det visuelt? For så får jeg lige lavet et eksempel, så du måske kan se hvad jeg mener.
Er det noget man kan få den til? Ligesom du har lavet formlen så tilpasser sig antal rækker, skal dette nemlig også kunne tilpasses antal rækker. Jeg har sendt et link til dropbox i privat besked :)
'Fylder J11 ned til K11 Range("J11").Select Selection.AutoFill Destination:=Range("J11:K11"), Type:=xlFillDefault
'Skriver tekst og formler Range("K11").Formula = "Saldo" Range("K12").Formula = "=J12" Range("K13").Formula = "=K12+J13"
'Finder sidste række under J13 SidsteRækkeKolonneK = Range("J13").End(xlDown).Row 'Fylder K13 ned til sidste række under J13 Range("K13").Select Selection.AutoFill Destination:=Range("K13:K" & SidsteRækkeKolonneK)
'Kopierer farven fra Jxx til Kxx Range("K" & SidsteRækkeKolonneK).Interior.Color = Range("J" & SidsteRækkeKolonneK).Interior.Color
'Skriver tekst i Ixx Range("I" & SidsteRækkeKolonneK).Formula = "Restbeløb"
Jo, altså selve formlen som regner noget ud i kolonne K har vi, den er som den skal være. Bortset fra at den lige kopiere en tak for langt ned, men det overskrives jo ved at kopiere J over i K og så slette indholdet i K, så cellen blot er farvet :-)
'Fylder J11 ned til K11 Range("J11").Select Selection.AutoFill Destination:=Range("J11:K11"), Type:=xlFillDefault
'Skriver tekst og formler Range("K11").Formula = "Saldo" Range("K12").Formula = "=J12" Range("K13").Formula = "=K12+J13"
'Finder sidste række under J13 SidsteRækkeKolonneK = Range("J13").End(xlDown).Row 'Fylder K13 ned til sidste række under J13 Range("K13").Select Selection.AutoFill Destination:=Range("K13:K" & SidsteRækkeKolonneK)
'Kopierer farven fra Jxx til Kxx Range("K" & SidsteRækkeKolonneK).Interior.Color = Range("J" & SidsteRækkeKolonneK).Interior.Color
'Sletter indholdet i sidste celle i K Range("K" & SidsteRækkeKolonneK).Formula = ""
'Skriver tekst i Ixx Range("I" & SidsteRækkeKolonneK).Formula = "Restbeløb"
Sheets("Ark1").Select End Sub
Nu har jeg rettet lidt på din(udfyldelse af tekst fungerer ! :-) ), da der stod noget i sidste celle i kolonne K. Men en mindre detalje mangler fortsat. Den nederste linje har gitter om sig, så kan både farve og gitter hele vejen rundt om cellen tilføjes?
Det er helt i orden - jeg har lige forsøgt, men det fungerer ikke helt. Jeg har forsøgt med denne ved at indspille den og rette lidt i den, men den fungerer heller ikke helt ;-):
Sub kanter() ' ' kanter Makro '
' Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range("K" & SidsteRækkeKolonneK).Select End Sub
Men tusind tak for din hjælp!! :)
Synes godt om
Ny brugerNybegynder
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.
