Avatar billede living8671 Nybegynder
24. oktober 2010 - 01:34 Der er 22 kommentarer og
1 løsning

Samle data fra mange filer - til et samle-ark, via makro eller lign!

Hej Eksperter,

Jeg har ca.100 excel filer med forskellige navne, samlet i samme folder på min PC. Hver fil indeholder et ark med data (Ark1) med reservedele top-30 salg i et fast dataområde (A6 - N35).
Jeg kunne godt tænke mig hjælp til en makro eller lign., som tager dataområdet A6 - N35 fra samtlige filer i folderen, og "klistrer" alle disse data ind i samme ark sådan så alle top-30 lister bliver opsat fortløbende under hinanden! Og nu til den tricky del  ... på den ny-samlede liste vil flere varer gå igen, men makroen skal sørge for at hver vare kun bliver vist en gang, og det skal være den med mest salg der bliver vist, de øvrige dubletter skal sorteres væk. Den endelige liste skal til sidst sorteres faldende efter række N. Varenavnet står i række B, og salget står i række N ... Er det noget i super eksperter kan hjælpe med? Forresten ligger overskriften på mine hitlister i området A3 - N5 (samme på alle ark). Kan man få den overskrift med over på den samlede liste, vil det være fedt.
På forhånd mange tak for hjælpen.
Avatar billede finb Ekspert
24. oktober 2010 - 10:43 #1
Er de 100 filer helt ens mht. opstillingen af data ?
Avatar billede living8671 Nybegynder
24. oktober 2010 - 13:46 #2
Ja, det er de.
Avatar billede living8671 Nybegynder
25. oktober 2010 - 19:32 #3
Piv piv... er der slet ingen hjælp at hente på denne forespørgsel?
Avatar billede finb Ekspert
26. oktober 2010 - 08:21 #4
Arbejder på det...
Mvh finb
Avatar billede L_Amtoft Mester
26. oktober 2010 - 11:04 #5
har en makro der sortere og fjerner dubletter, den har ikke noget kriterier om f.eks. nyeste eller størst salg
men den kan måske inspirere eller hjælpe
mvh Lars


Sub SortereKontrakter()
' sortere kontrakterne på fanen 'kontrakter' og fjerner dubletter
' kaldes fra makroen OpdatereKontrakter

    Sheets("kontrakter").Select
    Range("A1").Select
    ActiveWorkbook.Worksheets("kontrakter").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("kontrakter").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A4:A500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("kontrakter").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$L$500").RemoveDuplicates Columns:=1, Header:=xlYes
    Sheets("MENU").Select
    Range("A1").Select
End Sub
Avatar billede L_Amtoft Mester
26. oktober 2010 - 11:08 #6
har du makroen til at hente fra de forskellige regneark ?
/LA
Avatar billede living8671 Nybegynder
26. oktober 2010 - 17:46 #7
#L_Amtoft
Tak - men jeg har absolut ingen forstand på makroer, så jeg kan desværre ikke selv arbejde videre på den. Men ellers tak.

#finb
Det lyder lækkert, jeg glæder mig allerede - og tak.
Avatar billede finb Ekspert
28. oktober 2010 - 09:59 #8
Dette er ikke kønt, men det virker.
Opret en master-fil i Excel, tast ALT+F11, og indsæt nedenstående makro.
Jeg har tilrettet Ransborgs makro, giv ham pointene:

Option Explicit
Sub GetAllData()

Dim FS As FileSearch
Dim FilePath As String
Dim FileSpec As String
Dim i As Long
'Dim v As Variant
Dim rTarget As Range
Dim ToSheet As Worksheet
Dim Data As Variant
Dim Salgstal_max_vaerdier As Range
Dim SalgsTalAktuelFil As Range
Dim Celle_i_salgstal_max_vaerdier
Dim Celle_i_salgsTalAktuelFil
'Dim AktueltSalgstal_i_AktuelFil As Single
'dim array-master:
Dim Salgstal_Master() As Single
Dim M As Integer
M = 1
ReDim Salgstal_Master(M)
Dim VisM As Integer

'FilePath = Den sti, hvor dine 100 filer ligger, fx:
FilePath = "C:\WINDOWS\Desktop\Excel-filer\ ...osv...

'FileSpec = Det navnemønster, dine 100 filer har, fx:
'"MangeFiler_001.xls" , "MangeFiler_002.xls" , osv... , bliver
'til søgemasken:

FileSpec = " MangeFiler_*.xls"

Set ToSheet = Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier") ''ThisWorkbook.Worksheets("AlleMaxVaerdier") ''Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier") ''ThisWorkbook.Worksheets("AlleMaxVaerdier")
Set Salgstal_max_vaerdier = ToSheet.Range("N6:N35")
Salgstal_max_vaerdier.Select
'MsgBox ""
Salgstal_max_vaerdier.Clear
'MsgBox ""
 
'Find nu Excel-filerne:

Set FS = Application.FileSearch
   
With FS
  .LookIn = FilePath
  .Filename = FileSpec
  .SearchSubFolders = False  'Søg ej underfoldere
  .Execute                    'If .FoundFiles.Count = 0 Then ' MsgBox ("Ingen filer fundet") ' Exit Sub ' End If
End With

'Hent data i aktuel fil:

For i = 1 To FS.FoundFiles.Count
  Workbooks.Open Filename:=FS.FoundFiles(i)
  Range("A1").Select
  MsgBox "Du står i denne fil:" & vbCrLf & FS.FoundFiles(i)
 
  Set SalgsTalAktuelFil = Range("N6:N35")
      SalgsTalAktuelFil.Select
      'MsgBox ""

  'Indledningsvis er alle data i ark 1 max-værdier; alle lægges over i master-filen:

  If i = 1 Then
    Set Data = Range("a3:n35")
    Data.Select
    Data.Copy
    ToSheet.Range("a3").PasteSpecial
    Application.CutCopyMode = False
    'MsgBox ""
  End If
 
  SalgsTalAktuelFil.Select

    Dim Salgstal() As Single
    Dim S As Integer
    S = 1
    ReDim Salgstal(S)
    Dim VisS As Integer

  For Each Celle_i_salgsTalAktuelFil In SalgsTalAktuelFil
    Celle_i_salgsTalAktuelFil.Select
       
      Salgstal(S) = Celle_i_salgsTalAktuelFil.Value
      S = S + 1
      ReDim Preserve Salgstal(S)
  Next Celle_i_salgsTalAktuelFil

    'MsgBox "Alm. salgstal er nu lagt i array"
        'For VisS = 1 To UBound(Salgstal) - 1
          'MsgBox VisS & ". høstede:" & vbCrLf & Salgstal(VisS)
          'Salgstal_max_vaerdier.Select ''Salgstal_max_vaerdier.Cells(S).Select
        'Next VisS

      MsgBox "filen lukkes"
  ActiveWorkbook.Close True                'ActiveWorkbook.Close False
      'MsgBox "filen lukkes"

      ToSheet.Activate ''' vis master-fil
      'MsgBox "Dette er Master-filen"
      Salgstal_max_vaerdier.Select
      'MsgBox "Master-filens salgstal"

' array master her:

      For Each Celle_i_salgstal_max_vaerdier In Salgstal_max_vaerdier
        Salgstal_Master(M) = Celle_i_salgstal_max_vaerdier
        M = M + 1
        ReDim Preserve Salgstal_Master(M)
      Next Celle_i_salgstal_max_vaerdier
     
      'MsgBox "Master-salgstal er lagt i array"
     
          VisM = 0 '''' TEST !!!!!!!!!!
      For VisM = 1 To 30 'UBound(Salgstal_M) - 1
        If Salgstal(VisM) > Salgstal_Master(VisM) Then
          'MsgBox VisM & ". række i begge filer:" & vbCrLf & _
                Salgstal(VisM) & " - i aktuel fil" & vbCrLf & _
                Salgstal_Master(VisM) & " i master-fil" & vbCrLf & _
                "fil-tal er større end master-tal, som nu ondannes t fil-tal"
          Salgstal_Master(VisM) = Salgstal(VisM)
     
      'Nu skrives det større tal fra alm. fil i master-filens salgstal-range:
         
          Salgstal_max_vaerdier.Cells(VisM).Select
          'MsgBox "se gl værdi i master-salgstal"
          Salgstal_max_vaerdier.Cells(VisM) = Salgstal(VisM)
          MsgBox " d nye større værdi er nu skrevet i masterRanget"
         
        End If
      Next VisM                  '"første master-tal: " & Salgstal_max_vaerdier.Cells(1).Value

Next ''Undersøg næste fil

End Sub

Overvej, om du fremover vil lægge alle filer i een fil, på hver sit ark.
Døb arkene "101030", "101031", 101101", osv., så du senere kan sortere arkene.
Filen bliver langsom og stor, til gengæld kan du konsolidere
NÅRSOMHELST og find min, max, gennemsnit, osv.

Mvh finb
Avatar billede living8671 Nybegynder
29. oktober 2010 - 22:03 #9
Hej finb,

Jeg får desværre "Subscript out of range" når jeg afvikler makroen. Jeg benytter Excel2003, ved om om det gør nogen forskel?
Avatar billede finb Ekspert
30. oktober 2010 - 11:01 #10
Tast ALT+F11,
klik et tilfældigt sted i makroen.

Afspil: Hold tasten F8 (på tastaturet) inde, indtil makroen går i stå, og skriv tilbage hertil, hvor  i makroen, fejlen opstår.

mvh finb
Avatar billede living8671 Nybegynder
30. oktober 2010 - 13:25 #11
Tak.
Den går i stå her:
Set ToSheet = Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier") ''ThisWorkbook.Worksheets("AlleMaxVaerdier") ''Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier")
Avatar billede finb Ekspert
31. oktober 2010 - 08:27 #12
Følgende:

Set ToSheet = Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier")

virker, hvis din master-fil hedder:
"Saml_mange_ark_MASTER"

Ellers skal du erstatte "Saml_mange_ark_MASTER" med navnet på din master-fil.

OG:

Hele smøren:
Set ToSheet = Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier")

-skal stå i samme linie i makroen.

OG:

dit master-regneark (eet ark) skal hedde:

"AlleMaxVaerdier"

-eller også skal du ændre makroens ark-navn "AlleMaxVaerdier" til det ark-navn, du selv bruger.

OG:
Sidst i dit indlæg #11:
Slet eksakt disse linier:

''ThisWorkbook.Worksheets("AlleMaxVaerdier")
''Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier")

-og prøv igen...
Avatar billede living8671 Nybegynder
31. oktober 2010 - 16:27 #13
Hej finb,

Den virker desværre ikke....

Når jeg har lavet dine ændringsforslag stopper fejlen, men det eneste der sker i master-filen, er at kolonne N6 - N35 bliver fremhævet, men der kommer ingen tal i arket.
Jeg har omdøbt master-filen til "Saml_mange_ark_MASTER" og omdøbt "sheet1" i master-filen til "AlleMaxVaerdier" og til sidst har jeg slettet de 2 linier du bad mig om!

Alle de filer jeg skal indsamle data fra, starter med "DOHA top 30" -og derefter et tal som ikke har noget mønster. I FileSpec har jeg derfor skrevet FileSpec = " DOHA_*.xls"

Mvh
living8671
Avatar billede finb Ekspert
02. november 2010 - 08:12 #14
Slet UNDERSCORE i:

FileSpec = " DOHA_*.xls"

så der i stedet står:

FileSpec = " DOHA*.xls"

-og klik et tilfældigt sted i makroen,
prøv at afspille makroen med tasten F5.
Avatar billede living8671 Nybegynder
02. november 2010 - 17:11 #15
Hej finb,

Der sker det samme!

Mvh
Living8671
Avatar billede finb Ekspert
03. november 2010 - 12:07 #16
Har du i FilePath=
skrevet den nøjagtige sti, hvor din master-fil ligger ?

Du kan kopiere stien fra master-filen:

filer>>egenskaber>>generelt>>placering
Avatar billede living8671 Nybegynder
03. november 2010 - 12:52 #17
Hej finb,

Stien i FilePath er god nok:
FilePath = "C:\Documents and Settings\Thom\Skrivebord\reservedel"

Har lagt mit master-ark her, så du evt. kan se hvordan makroen ser ud hos mig.

http://www.gratisupload.dk/download/51508/

Mvh
living8671
Avatar billede finb Ekspert
04. november 2010 - 12:51 #18
Gå ind på PeeCee.dk

Der har jeg lagt 4 filer, datafil 1 til 4
og en master-fil. De fungerer sammen.

Søg i uploads og skriv i
søgestrengen: saml_mange

Når du downloader de 4 filer, skal du lægge dem i samme mappe på din pc.

Mvh finb
Avatar billede living8671 Nybegynder
08. november 2010 - 19:44 #19
Hej finb

Det virker desværre stadig ikke!
Jeg får adskellige run-time errors.
Modul 1: run-time error 1004
Modul 2: run-time error 438
Modul 2: run-time error 1004

Mvh
living8671
Avatar billede finb Ekspert
10. november 2010 - 09:13 #20
hej living

Slet modul 1.

Jeg kender ikke run-time-error,
spørg her på eksperten, om nogen kan hjælpe.

mvh finb
Avatar billede living8671 Nybegynder
29. marts 2011 - 14:54 #21
Send et svar og pointene er dine - nu virker "skidtet" :)
Avatar billede living8671 Nybegynder
13. februar 2012 - 16:20 #22
Lukker denne
Avatar billede larsv Nybegynder
20. oktober 2013 - 11:07 #23
Hej..

Jeg har netop forsøgt, at bruge denne kode, så jeg kan opsamle info fra flere regneark.

Jeg bruger Excel 2013 og her virker det som om, at funktionen  Application.FileSearch ikke længere virker.

Er der nogen der har et bud på, hvad jeg så skal bruge?

Hilsen fra Lars
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
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

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