Avatar billede Nummee Mester
24. september 2019 - 16:05 Der er 9 kommentarer og
1 løsning

Hente data fra en celle

Jeg har et Master.xlsm liggende på mit skrivebord, er det muligt at hente data fra en celle i flere regneark som ligger i en anden mappe C:\Users\Administrator\Desktop\Lønseddler\Per\2019\MP-Regnskab og indsætte det i mit Master.xlsm regneark ?

Jeg vil gerne lave et diagram i min master.xlsm i et ark jeg kalder sygdom og derfra hente alle data fra arket Ugeseddel_Rødovre celle K28 fra alle andre regneark jeg har liggende i mappen C:\Users\Administrator\Desktop\Lønseddler\Per\2019\MP-Regnskab kan det lade sig gøre ?
Avatar billede Jan Hansen Ekspert
24. september 2019 - 23:38 #1
Hej
Det er svært da et ark skal være åbent for at du kan hente data fra det så:

1. arket skal åbnes
2. data overføres
3. Arket lukkes

Det vil blive sløvt!!

En anden tilgang er at master altid er åbent når et af arkene laves og at sygdomsdata overføres til en fane på masteren!!

Alt i alt en svær øvelse, tror der er andre der er bedre end mig til at løse den nød!!
Avatar billede M.O Seniormester
26. september 2019 - 17:36 #2
Jeg har et hurtig udkast til VBA, men det skal tilrettes så det rammer det rigtige ark ("Ugeseddel_Rødovre")  i excel filerne under mappen C:\Users\Administrator\Desktop\Lønseddler\Per\2019\MP-Regnskab

det henter data ind på det aktiv ark hvorfra kode køres.

Hvis du har mod på det vil jeg anbefale at teste det først.


Option Explicit
Sub Scan()
    Dim FSO As Object 'FileSystemObject
    Dim fldStart As Object 'Folder
    Dim fld As Object 'Folder
    Dim fl As Object 'File
    Dim Mask As String
   
  ' Tilføjet
    Dim R As Integer
    Dim WB As Workbook
    Dim intResult As Integer
    Dim strPath As String
    Dim UserName As String
    UserName = Environ("username")
   
   
    'Slet ark hvis det eksistere
  ' Application.DisplayAlerts = False
  ' On Error Resume Next
  ' ThisWorkbook.Worksheets("Sygdom").Delete
  ' On Error GoTo 0
  ' Application.DisplayAlerts = True
   
    'Tilføj nyt ark
  ' With ThisWorkbook
  '    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Sygdom"
  ' End With
         
   
    ' Dialogboks til valg af mappe
  With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\Users\" & UserName & "\"
        .AllowMultiSelect = False
        .Title = _
    "Vælg Bibliotek der skal scannes"
        .ButtonName _
    = "Vælg Mappe"
    intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
End With
    'check om dialogboks er annulleret
    If intResult <> 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    ' Slut ---------
                 
    Set FSO = CreateObject("scripting.FileSystemObject") ' late binding
    Set fldStart = FSO.getfolder(strPath)
     
    R = 1
   
    Mask = "*.xlsx"
    ListFiles fldStart, Mask, R
    For Each fld In fldStart.subfolders
        ListFiles fld, Mask, R
        ListFolders fld, Mask, R
    Next
    End If
   
End Sub


Sub ListFolders(fldStart As Object, Mask As String, R As Integer)

    Dim fld As Object 'Folder
    For Each fld In fldStart.subfolders
      ' Debug.Print fld.Path & "\"
        ListFiles fld, Mask, R
        ListFolders fld, Mask, R
    Next
   
End Sub

Sub ListFiles(fld As Object, Mask As String, R As Integer)
   
  Dim WS As Worksheet
  Dim fl As Object 'File
  Set WS = ActiveSheet
 
         
  For Each fl In fld.Files
        If fl.Name Like Mask Then
         
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            Workbooks.Open Filename:=fld.Path & "\" & fl.Name
           
            If IsEmpty(Range("K28").Value) Then
                                 
                        Debug.Print "Cellen er tom"
                       
              Else
                        Debug.Print "Fundet indtastning i K28  " & fld.Path & "\" & fl.Name
                                               
              R = R + 1
              WS.Cells(R + 1, 4) = Cells(28, 11) ' Indsætter data fra K28 på i kolonne D
                   
            End If
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            ActiveWorkbook.Close False
           
      End If
    Next
End Sub
Avatar billede Nummee Mester
26. september 2019 - 19:16 #3
Det var godt nok en lang kode, jeg kigger og afprøver det hurtigst muligt så vender jeg lige tilbage igen, rigtig mange tak for din hjælp håber jeg kan bruge det, skal lige nær studere koden, det jo ikke min stærkeste side men det ser fornuftig ud så det tror jeg på jeg nok skal finde ud af :-)

Ps. Skal jeg oprette det som et modul eller skal koden ind i det aktive ark Ugeseddel_Rødovre ?
Avatar billede Nummee Mester
26. september 2019 - 21:25 #4
Det ser ud til at virke jeg får ingen fejlmeddelelser men der kommer heller ingen data ind i det aktive ark Sygdom

I linje 51 har du skrevet
Mask = "*.xlsx"

Nu er alle mine regneark gemt i makro filformat, så jeg går ud fra linje 51 skal rettes til

Mask = "*.xlsm"

Så skete der noget jeg kan se på mit Sygdoms ark at scrool linjerne kører op og ned, men ingen data bliver tilføjet til Arket, jeg har lavet en lille makro knap og tilføjet din kode men som sagt skriver den ingen overførte data ind i arket ?
Avatar billede M.O Seniormester
26. september 2019 - 21:33 #5
Det skal indsættes i et modul.
Lav evt. en test.xlsm fil og indsæt det deri  - kopiere et par filer fra C:\Users\Administrator\Desktop\Lønseddler\Per\2019\MP-Regnskab i en test mappe så du ikke rører originalerne.

Der kommer en dialogboks hvor du kan vælge hvilken bibliotek der skal scannes i.

Jeg håber noget af det kan hjælpe.
Avatar billede Nummee Mester
26. september 2019 - 21:36 #6
Ha ha kunne jo være man lige skulle komme lidt info i K28 i de ark den skal hente fra så nu kom der lidt data ind i det aktive ark, jeg skal lige kigge det lidt mere igennem, jeg skal nok vende tilbage asap glemmer dig ikke :-)

Kanon arbejde må jeg sige klasse work :-)
Avatar billede Nummee Mester
28. september 2019 - 12:44 #7
Ja det tager lidt tid for mig at prøve at sætte mig lidt ind i din kode.

Jeg har så fundet ud af at

WS.Cells(R + 1, 4) = Cells(28, 11)

er den linje du bruger for at sætte data ind i celle D3 fra celle K28 so far so good :-)

Men det ser ud til den tilføjer en uge ad gangen fra celle D3, så D4 osv.

Er det muligt også at få den til at tilføje de samlet data fra K28 i alle ark som en samlet sum i feks. celle E3 den skal stadig samle data i celler D3 osv ?
Avatar billede M.O Seniormester
30. september 2019 - 14:57 #8
Jeg er ikke helt med på spørgsmålet.

Udmiddelbart læser jeg det som du skal lave en autosum af Kolonne D.
Avatar billede Nummee Mester
04. oktober 2019 - 22:44 #9
Hej
Undskyld det sene svar, jeg har ligget vandret hele ugen.

Det jeg mener er, som det er nu ligger den alle tal sammen fra celle K28 i alle scannede ark men ikke i samme celle.

Scan finder sygdom i 3 af de scannede ark, 1 ark 21 timer, 2 ark 7 timer og 3 ark 2 timer så i stedet for at ligge dem sammen i samme celle, ligger den dem sammen i D3 = 21, D4 = 7, D5 = 2

Ville nu gerne have den regnet alle arkne ud i celle D3 så ville resultatet bliver 30 timer håber jeg har forklaret mit nogen lunde fornuftigt :-)
Avatar billede M.O Seniormester
07. oktober 2019 - 12:20 #10

Det jeg mener er, som det er nu ligger den alle tal sammen fra celle K28 i alle scannede ark men ikke i samme celle.


- Koden henter hvad end der står i K28 i de scannede ark  - der laves ikke nogen Autosum.

Hvis du gerne vil have en færdig sum af alle de indhentede K28 celler - kan du lave et ekstra Ark hvor de celler hentes ind til og derefter lave en autosum af de indhentede celler til Celle D3.
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

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.

Du kan også logge ind via nedenstående tjenester