Søg
Avatar billede s_kjaer Praktikant
06. september 2004 - 19:46 Der er 32 kommentarer og
1 løsning

Hente data fra andet regneark og sortere data

Hej

Jeg har lige, med stor hjælp fra Kabbak, arket fra dette spm. til at virke perfekt: http://www.eksperten.dk/spm/536093

Men i kender jo chefer, når en ting virker, så har de jo straks en masse ideer, som man skal forsøge at løse.

Sagen er nu den at jeg skal have lavet et nyt regneark, hvor alle de planlagte timer skal sorteres ude på oa 41 ansatte, således at man let kan se hvor mange timer hver ansat har på hvilken opgave.

Selv om jeg lige var ved at få lidt selvtillid med hensyn til macroer, så har jeg brug for hjælp igen.

Jeg har optaget en macro der låser arket op, henter data fra den anden fil, og bagefter låser arket igen, men den tager ikke række 3 med over, og der står initialerne på os ansatte, så det er en meget vigtig linie.

Hvad er der galt med koden, siden den udelader denne linie?

Sub hent_data()
'
' Makro hent_data Makro
' Makro indspillet 06-09-2004 af Søren Kjær
'

'
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=M:\Planlægning økonomiafdeling\Plan pr. kunde 2004-05\Tim" _
        , _
        "er pr. kunde 2004-5 macro.XLS;Mode=Share Deny Write;Extended Properties=""HDR=NO;"";Jet OLEDB:System database="""";Jet OLEDB:Registr" _
        , _
        "y Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bul" _
        , _
        "k Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB" _
        , _
        ":Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SF" _
        , "P=False"), Destination:=Range("A1:BB725"))
        .CommandType = xlCmdTable
        .CommandText = Array("Samlet$Print_Area")
        .Name = "Timer pr. kunde 2004-5 macro"
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "M:\Planlægning økonomiafdeling\Plan pr. kunde 2004-05\Timer pr. kunde 2004-5 macro.XLS"
        .Refresh BackgroundQuery:=False
    End With
End Sub

Mit næste problem er så at få sorteret data ud på de enkelte ark, og her vil jeg oså meget gerne have jeres hjælp.

Initialer for hver ansat er i cellerne I3:aw3, og de data ser skal sorteres er i området I5:AW702

Arkene der skal sorteres til hedder det samme som initialerne eks: ved de opgaver jeg har timer på, skal hele rækken flyttes til arket SK

Søren
Avatar billede kabbak Professor
06. september 2004 - 21:00 #1
Jeg kan ikke lige overskue den kode, men hvis den tror at navnene er overskrifter, så prøv at rette denne linie.

  .FieldNames = False
til

  .FieldNames = True
Avatar billede s_kjaer Praktikant
06. september 2004 - 21:09 #2
Jeg prøver at ændre det, men hvis du har en ide til hvordan det bedre kan laves bedre, er du meget velkommen til at komme med et forslag.
Jeg har været ved at søge efter tidligere spm. om det samme, men med mine evner kunne jeg ikke finde noget jeg umiddelbart kunne gemmenskue
Avatar billede s_kjaer Praktikant
06. september 2004 - 21:14 #3
Fieldsnames gør bare at den sætter rækkenummeret i kolonne A, så det hjælper mig ikke ret meget :-(
Avatar billede bak Forsker
06. september 2004 - 21:26 #4
så må du da have sat noget forkert
.RowNumbers = True sætter rækkenumre på
Avatar billede s_kjaer Praktikant
06. september 2004 - 21:27 #5
Prøver lige at logge på arb. igen, har kun filerne liggende der.
Avatar billede s_kjaer Praktikant
06. september 2004 - 21:34 #6
Det virker stadig ikke, da den nu sætter "navene" på kolonnerne. F1 ved kolonne A, F2 ved kolonne B osv.
Avatar billede s_kjaer Praktikant
06. september 2004 - 21:45 #7
Det mærkelige er at den godt kan hente felterne D3 og E3, mens den giver op når den når til I3, hvor initialerne begynder.
Avatar billede kabbak Professor
06. september 2004 - 21:58 #8
Hvad er det egentlig du vil, der det ikke at hente alt i et ark på en anden mappe og få det ind på et ark i en nu mappe.

Hvis det er sådan,Så optag en makro mens du gør sådan

Du står på et ark i den mappe hvor koden skal være, og dine data skal over i.

Start optageren.

Vælg åben den anden mappe med dataerne i, find arket med data, Maker heke arket, vælg kopier, gå via Vindue tilbage på det ark du kom fra maker celle A1, paste.

Gå tilbage til den anden mappe igen, og luk det, klik ind på celle A! hvis arket er makeret. stop makroen.

Sæt koden herind, for at få den tilrettet
Avatar billede s_kjaer Praktikant
06. september 2004 - 22:21 #9
Hvorfor f...... har jeg ikke tænkt på det noget før, jeg troede ikke at der var en så simpel løsning på problemer. Det virker fint kabbak, så jeg tror ikke at der er behov for tilretning. Så mangler jeg kun at få data sorteret efter række 3, og der går jeg ud fra at jeg kan genbruge konden fra det sidste spm., men jeg kan ikke se hvor jeg skal ændre.
Her er den kode jeg har fra sidste spm: ublic Sub CopyRaekker(Ark As String)
Dim RW As Integer
RW = Worksheets(Ark).Range("A65536").End(xlUp).Row
  Worksheets(Ark).Rows("6:" & RW).ClearContents ' tømmer den opgaveansvarliges ark
X = 6
RW = Worksheets("samlet").Range("A65536").End(xlUp).Row
For j = I To RW
If Worksheets("samlet").Row("3" & I) = Ark Then
Worksheets("samlet").Rows(I & ":" & I).Copy
Sheets(Ark).Paste Destination:=Worksheets(Ark).Cells(X, 1)
X = X + 1
  End If
Next

End Sub
Avatar billede kabbak Professor
06. september 2004 - 22:29 #10
Hvad mener du, er dataerne Lodret, så det er kolonner der skal flyttes, eller hvad
Avatar billede s_kjaer Praktikant
06. september 2004 - 22:29 #11
Her er den kode den optog:Sub hent2()
'
' hent2 Makro
' Makro indspillet 06-09-2004 af Katrine Jacobsen og Søren Kjær
'

'
    ActiveCell.FormulaR1C1 = _
        "='[Timer pr. kunde 2004-5 macrotest060904.XLS]Samlet'!R2C1"
    Range("A1").Select
    Selection.Cut Destination:=Range("A2")
    Range("A2").Select
    ActiveCell.FormulaR1C1 = _
        "='[Timer pr. kunde 2004-5 macrotest060904.XLS]Samlet'!RC"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:AW2"), Type:=xlFillDefault
    Range("A2:AW2").Select
    Selection.AutoFill Destination:=Range("A2:AW721"), Type:=xlFillDefault
    Range("A2:AW721").Select
    ActiveWindow.ScrollRow = 705
    ActiveWindow.ScrollRow = 689
    ActiveWindow.ScrollRow = 668
    ActiveWindow.ScrollRow = 642
    ActiveWindow.ScrollRow = 605
    ActiveWindow.ScrollRow = 557
    ActiveWindow.ScrollRow = 509
    ActiveWindow.ScrollRow = 448
    ActiveWindow.ScrollRow = 383
    ActiveWindow.ScrollRow = 318
    ActiveWindow.ScrollRow = 253
    ActiveWindow.ScrollRow = 197
    ActiveWindow.ScrollRow = 153
    ActiveWindow.ScrollRow = 127
    ActiveWindow.ScrollRow = 111
    ActiveWindow.ScrollRow = 104
    ActiveWindow.ScrollRow = 99
    ActiveWindow.ScrollRow = 98
    ActiveWindow.ScrollRow = 94
    ActiveWindow.ScrollRow = 89
    ActiveWindow.ScrollRow = 87
    ActiveWindow.ScrollRow = 74
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 42
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 41
    ActiveWindow.ScrollColumn = 37
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveCell.FormulaR1C1 = _
        "='[Timer pr. kunde 2004-5 macrotest060904.XLS]Samlet'!R1C1:R1C7"
    Range("A1:G1").Select
    Range("G1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Columns("A:AW").Select
    Range("A2").Activate
    Selection.Columns.AutoFit
    ActiveWindow.DisplayZeros = False
End Sub
Avatar billede kabbak Professor
06. september 2004 - 22:33 #12
Hvad er det for en kode, det er da ikke den jeg bad dig om at optage, er det ?
Avatar billede s_kjaer Praktikant
06. september 2004 - 22:35 #13
Arket er opbygget således at vi medarbejdere har hver vores kolonne fra I til AW, så alle de timer jeg skal arbejde på de forskellige opgaver er eksempelvis i kolonne AQ. Planen er så at få alle de rækker hvor der er timer i kolonne AW ud på arket "SK"
I det tidligere spm. blev der sorteret på ansvarlig konsulent, der var angivet i kolonne D.
Initialerne står i række 3
Avatar billede kabbak Professor
06. september 2004 - 22:35 #14
hvis jeg optager, ser det sådan ud.

Sub Makro1()

    Workbooks.Open Filename:= _
        "E:\Documents and Settings\Dokumenter\Excel\Banko.xls"
    Cells.Select
    Selection.Copy
    Windows("Mappe1").Activate
    Range("A1").Select
      ActiveSheet.Paste
    Windows("Banko.xls").Activate
    ActiveWindow.Close
End Sub
Avatar billede s_kjaer Praktikant
06. september 2004 - 22:37 #15
Den sidste kode er den du bad mig om at optage. Henter data fra et andet ark, og indsætter dem i området a2 til aw721, derudover fravælges nulværdier og kolonnebredden tilpasses til indholdet.
Avatar billede s_kjaer Praktikant
06. september 2004 - 22:38 #16
Prøver lige igen, da din kode da ser noget mer overskuelig ud.
Avatar billede kabbak Professor
06. september 2004 - 22:39 #17
ok

Alle de steder der står

  ActiveWindow.ScrollColumn = X

dem kan du godt slette, det er når du skroller på skærmen
Avatar billede kabbak Professor
06. september 2004 - 22:42 #18
Jeg skal lige vide, dataerne starter de stadig i Række 6
Avatar billede s_kjaer Praktikant
06. september 2004 - 22:44 #19
Ja
Avatar billede kabbak Professor
06. september 2004 - 22:45 #20
Og A kolonner er stadig fyldt til sidste linie. ?
Avatar billede s_kjaer Praktikant
06. september 2004 - 22:49 #21
Ja
Avatar billede kabbak Professor
06. september 2004 - 22:52 #22
Public Sub CopyRaekker(Ark As String)
Dim RW As Integer
RW = Worksheets(Ark).Range("A65536").End(xlUp).Row
  Worksheets(Ark).Rows("6:" & RW).ClearContents ' tømmer den opgaveansvarliges ark
  For Each c In Range(Cells(3, 9), Cells(3, 49))
  If c.Value = Ark Then Exit For
  Next
X = 6
RW = Worksheets("samlet").Range("A65536").End(xlUp).Row
For j = I To RW
If Worksheets("samlet").Row(c.Row & I) <> "" Then
Worksheets("samlet").Rows(I & ":" & I).Copy
Sheets(Ark).Paste Destination:=Worksheets(Ark).Cells(X, 1)
X = X + 1
  End If
Next

End Sub

Du skal stadig bruge den lille kode på medarbejdernes ark
Avatar billede kabbak Professor
06. september 2004 - 22:56 #23
der er fejl vent lige
Avatar billede s_kjaer Praktikant
06. september 2004 - 22:56 #24
Tak skal du ha'. Jeg kan se at jeg var meget tæt på at have den rigtig, da jeg kun manglede at rette denne del:Row(c.Row & I) <> 

Smider du et svar? Jeg stopper for i dag, så det bliver først testet imorgen, men jeg er sikker på at det nok skal virke.

Søren
Avatar billede s_kjaer Praktikant
06. september 2004 - 23:00 #25
Ok, jeg venter med at smutte. Jeg kom til at tænke på om det var muligt at den lavede en sammentælling i den nederste linie efter den har hentet data fra arket "samlet"?
Avatar billede kabbak Professor
06. september 2004 - 23:07 #26
Prøv denne

Public Sub CopyRækker(Ark As String)
Dim RW As Integer
RW = Worksheets(Ark).Range("A65536").End(xlUp).Row
  Worksheets(Ark).Rows("6:" & RW).ClearContents ' tømmer den opgaveansvarliges ark
  For c = 9 To 49
  A = Worksheets("samlet").Cells(3, c)
  If A = Ark Then Exit For
  Next
X = 6
RW = Worksheets("samlet").Range("A65536").End(xlUp).Row
For i = 6 To RW
If Worksheets("samlet").Cells(i, c) <> "" Then
Worksheets("samlet").Rows(i & ":" & i).Copy
Sheets(Ark).Paste Destination:=Worksheets(Ark).Cells(X, 1)
X = X + 1
  End If
Next

End Sub
Avatar billede kabbak Professor
06. september 2004 - 23:11 #27
Med hensyn til sammentælling

Smid denne linie nederst i koden

Range("D" & X).FormulaR1C1 = "=SUM(R[-" & (X - 2) & "]C:R[-1]C)"

Ret Range("D" til den kolonne du vil summere i
Avatar billede kabbak Professor
06. september 2004 - 23:12 #28
Du laver bare flere af dem, hvis der er flere kolonner der skal summeres
Avatar billede kabbak Professor
06. september 2004 - 23:15 #29
Hvis det kun skal summeres under initialerne, så

Cells(X, c).FormulaR1C1 = "=SUM(R[-" & (X - 2) & "]C:R[-1]C)"
Avatar billede s_kjaer Praktikant
07. september 2004 - 22:30 #30
Hej igen.

Arket fungere som det skal nu, så det er tid til at du får point for den store hjælp.

Som du rådede mig til, er jeg begyndt at bruge optagefunktionen mere, så jeg nu også så småt kan tilføje og ændre linier i macroen, uden at få ret mange fejlmeddelser :-).

Smider du et svar?

SKJ
Avatar billede kabbak Professor
07. september 2004 - 22:34 #31
et svar ;-))

Ja, man kan lære meget af makro optageren, men den laver ofte nogen unødvendige lange koder, som man så retter til.
Avatar billede s_kjaer Praktikant
07. september 2004 - 22:37 #32
Der er problemet jo nok. Indtil videre er jeg glad bare lortet virker og lever med en lang kode, men jeg bliver jo nok så nysgerrig på et tidspunkt, at jeg begynder at korte dem af.
Avatar billede kabbak Professor
07. september 2004 - 22:38 #33
tak for point
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Ændre tal i en celle Af xvid i Excel 1 04/09/202616:05 04/09/202616:54
Kan Excel selv beregne alder? Af leahcim i Excel 7 31/08/202610:24 04/09/202602:08
problem med mailbesked Af Pestilensen i Excel 3 24/08/202611:16 28/08/202612:55
Sætte billeder ind i google sheets ark ud fra elev nummer Af lurup i Excel 18 17/08/202615:14 05/09/202622:04
Gemme største værdi Af Lemming@privat.dk i Excel 2 07/08/202622:13 08/08/202609:03
Se alle spørgsmål i kategorien Opret spørgsmål

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I går 17:00 Film Server Af dcedata1977 i Andet software
I går 12:56 Mistænkelige mails! Af ErikHg i E-mail
12/0914:10 Komme ind på : YouSeeMusic" Af Ikke-ekspert i Musik & videoafspillere
12/0913:27 Send/modtag i Outlook 2024 Af ErikHg i E-mail programmer
10/0915:34 Installer alarmlyd på Samsung Galaxy XCover 7 Pro Af ErikHg i Mobiltelefoner
White papers
Flere white papers »