Sum (relativ reference) i makro (1)

Sub Do_Loop_Linier()

Set Nummer = ActiveCell
rk = ActiveCell.Row           
Do While ActiveCell = Nummer
ActiveCell.Offset(1, 0).Select
Loop
    ActiveCell.Range("A1:K1").Select
    nrk = ActiveCell.Row           
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Range("G" & ActiveCell.Row).FormulaR1C1 = "=SUM(R[-" & nrk - rk & "]C:R[-1]C)"

    Range("A" & ActiveCell.Row).value =  Range("A" & ActiveCell.Row).offset(-1,0).value

  ActiveCell.Offset(2, 0).Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    If ActiveCell > 0 Then
Do_Loop_Linier
    Else:
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Application.ScreenUpdating = True
    Application.Dialogs(xlDialogSaveAs).Show
    End If

End sub

offset(-1,0)

-1 = rækken før
0 = samme kolonne

tallene styrer altså hvor langt fra den celle der skal have værdien, dataerne ligger.

håber du forstår det

Nu skal der være tid!
Tak for rådet. Ligesom sidste gang virker det bare.
Men jeg er stødt ind i et nyt problem. Makroen er indelt 6 dele, som stort set kører efter hinanden, men med Lopp.. og If sætninger i et par af dem.
Midt i afvikling er det som om, at den efter Lopp og If istedet for at acceptere Sub End kommando starter forfra på del makroen. Det kan jeg ikke grade.

Men jeg er nok "Klamphugger" på dette område. Vil du give et godt tip til at lære VBA rigtigt?
Hilsen og tak for hjælpen.

Igen, Tak for hjælpen

prøv at sende arket til mig, så vil jeg kikke på koden.

Skriv lige hvor det går galt.

Send Til#kabbak@tiscali.dk

fjern Send Til#

tip til at lære VBA rigtigt.

Optag makroer så tit det er muligt, se på koden og husk hvad du bad om.

er der udtryk du vil se på, klik ind på ordet og tryk F1, hjælpen er udmærket og med mange eksempler.

http://msdn.microsoft.com/vba/
http://www.udvikleren.dk/tech.php?techid=4
http://tommy.bak.homepage.dk/

her er nogle sider der også kan bruges.

kik også med i Visual Basic spørgsmålene, der er også VBA og de andrer ligner meget, så det kan du også lære af.

Her er hele makroen, hilsen

Sub Import_txt_1()
'
' Import_text Makro
' Makro indspillet 09-02-2004 af hp
'
' Genvejstast:Ctrl+q
'
'Application.ScreenUpdating = False
    Workbooks.OpenText Filename:="U:\Filer fra FT\inv.txt", Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
        28, 1), Array(29, 1), Array(30, 1), Array(31, 1))


        Vælge_Uddata_2
   
    End Sub
   
   
   
   
Sub Vælge_Uddata_2()
    '
    ActiveSheet.Activate
    Sheets.Add
    Sheets("Ark1").Select
    Sheets("Ark1").Name = "Uddata"
    Sheets("inv").Select
    Cells.Select
    Selection.Copy
    Sheets("Uddata").Select
    Cells.Select
    ActiveSheet.Paste
    Sheets("inv").Select
    Range("A1").Select
    Sheets("Uddata").Select
    Range("A1").Select
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A:C,F:G,J:K,N:N,P:AE").Select
    Range("P1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
Grupper_3

End Sub



Sub Grupper_3()


Set Nummer = ActiveCell
rk = ActiveCell.Row
Do While ActiveCell = Nummer
ActiveCell.Offset(1, 0).Select
Loop
    ActiveCell.Range("A1:K1").Select
    nrk = ActiveCell.Row
    Selection.Insert Shift:=xlDown
    Range("A" & ActiveCell.Row).FormulaR1C1 = "TOTAL"
    Range("G" & ActiveCell.Row).FormulaR1C1 = "=SUM(R[-" & nrk - rk & "]C:R[-1]C)"
    Range("H" & ActiveCell.Row).Value = Range("A" & ActiveCell.Row).Offset(-1, 0).Value
    Range("I" & ActiveCell.Row).Value = Range("B" & ActiveCell.Row).Offset(-1, 0).Value
    Range("M" & ActiveCell.Row).Value = Range("F" & ActiveCell.Row).Offset(-1, 0).Value
    Range("N" & ActiveCell.Row).Value = Range("G" & ActiveCell.Row).Value
    ActiveCell.Offset(1, 0).Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    If ActiveCell > 100 Then
      Grupper_3
    End If
    Range("A1").Select
   
'  Sumliste_4
 
End Sub





Sub Sumliste_4()
   
    Range("H1:N5000").Select
    Selection.Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("H1:N200").Select
    Selection.Cut
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    rk = ActiveCell.Row
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Select
    Selection.End(xlDown).Select
    nrk = ActiveCell.Row
    ActiveCell.Offset(1, 0).Range("A1").Select
    Range("G" & ActiveCell.Row).FormulaR1C1 = "=SUM(R[-" & nrk - rk & "]C:R[-1]C)"
    Range("A" & ActiveCell.Row).FormulaR1C1 = "TOTAL"
    MsgBox
   
Justering_5

End Sub

Sub Justering_5()


    Columns("A:A").Select
    Selection.ColumnWidth = 13
    Selection.NumberFormat = "0"
    Selection.NumberFormat = "# #### ####"
    With Selection
        .HorizontalAlignment = xlLeft
    End With
    Columns("B:B").Select
    Selection.ColumnWidth = 16
    With Selection
        .HorizontalAlignment = xlLeft
    End With
    Columns("C:C").Select
    Selection.ColumnWidth = 13
    With Selection
        .HorizontalAlignment = xlCenter
    End With
    Columns("D:D").Select
    Selection.ColumnWidth = 11
    With Selection
        .HorizontalAlignment = xlRight
    End With
    Columns("E:E").Select
    Selection.ColumnWidth = 16
    Selection.NumberFormat = "0"
    Selection.NumberFormat = "# #### ####"
    With Selection
        .HorizontalAlignment = xlRight
    End With
    Columns("F:F").Select
    Selection.ColumnWidth = 22
    With Selection
        .HorizontalAlignment = xlRight
    End With
    Columns("G:G").Select
    Selection.NumberFormat = "#,##0"
    Selection.ColumnWidth = 9
    With Selection
        .HorizontalAlignment = xlRight
    End With
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "UNITS"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "DISTINATION"
    Rows("1:1").Select
    Selection.RowHeight = 15
    Range("A1:G1").Select
    With Selection
        .VerticalAlignment = xlTop
    End With
' Udskriv_6

   
End Sub
   
Sub Udskriv_6()
   
   
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = "&10 POLARIS ELECTRONICS A/S,    LYNGVEJ 3,    P.O.Box 746,    DK-9100 AALBORG"
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&05 &D &T"
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.590551181102362)
        .TopMargin = Application.InchesToPoints(0.590551181102362)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.393700787401575)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = True
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Application.ScreenUpdating = True
    Range("A1").Select
   
End Sub

Hvor går den i selvsving, hvilken makro ?

I Sub Grupper og Sub Sumiste, det synes lidt forskelligt, men mest i Sumliste
hi´lse

Jeg kan ikke se det, jeg mangler dataerne.

Slutter for idag, er tilbage igen torsdag

Her er et lille udsnit af ca. 1000 linier. De skal adsilles og sammentælles og udskrives pr."Number", og på en sum-side skal total på hvert "number" være oplistet.

Hilsen

NUMBER    DATE    TIME    NUMBER OF UNIT
763612469    12-01-2003    15:50:14    179
763612469    12-01-2003    16:48:47    355
763612469    12-01-2003    16:56:53    554
763612468    12-02-2003    06:56:33    181
763612468    12-02-2003    08:15:53    1358
763612468    12-02-2003    08:42:01    249
763612467    12-02-2003    09:58:47    248
763612467    12-02-2003    16:59:49    188
763612467    12-03-2003    05:09:33    27
763612466    12-03-2003    05:59:51    7
763612466    12-03-2003    09:43:59    520
763612466    12-03-2003    11:02:43    751
763612465    12-03-2003    18:06:51    28
763612465    12-03-2003    18:08:20    454
763612465    12-03-2003    18:19:53    6
763612464    12-03-2003    19:36:32    706
763612464    12-04-2003    07:36:50    214
763612464    12-04-2003    07:43:12    620
763612463    12-04-2003    07:58:47    434
763612463    12-04-2003    09:07:40    75
763612463    12-04-2003    13:46:37    323

Hej Kabbak
Jeg spurgte Eksperten VBA om mit makro problem, og fik et svar, som er så logisk, at jeg ikke selv kunne se det.
Ved afslutning af en Sub vil makro fortsætte hvor Sub’en blev kaldt.
Jeg har nu tilføjet en ”hovedmakro”, som med et par tilføjelser ser sådan ud:

Sub Airtime()

Application.ScreenUpdating = False
    Import
    Vælge_Uddata
    Grupper
    Sumliste
    Justering
    Udskriv
    Application.ScreenUpdating = True
    Application.Dialogs(xlDialogSaveAs).Show
    ActiveWorkbook.Close
   
   
End Sub

Hovedmakro kalder de enkelte delmakroer og slutter ved dens End Sub.
Og nu virker det.
Efter 1 sekund kan jeg navngive uddata filen, som derefter lukkes samtidig med at spe-cifikationer kommer fra printeren.

Hilsen og tak for hjælpen

Godt at du fik løst dit problem med 'Selvsving', jeg havde faktisk glemt dig, så det var godt at du fik svar andet sted.

Tak for point. ;-))