Excel meerdere bestanden importeren met macro.

[Langerakpc]

Beste medetweakers,

Ik heb een database met 100tal bestanden .ddf (wordt ingelezen als tekst).
dit bestand importeer ik naar blad 1.
In deze bestanden staan een tweetal zaken die ik nodig heb.
- datum en tijd Cel B10 en B10.
- meet gegevens Cel B204 t/m B304 .

Die genoemde bestanden doe ik het volgende mee.
- Datum en tijd voeg ik samen in een willekeurige cel en die waardes kopieer ik naar rij1 en dan de eerste lege kolom beginnend in kolom B.
- meetgegevens: die kopieer ik naar de eerste beschikbare kolom in rij 2 t/m 102 en beginnend in kolom B.

in kolom A staan vaste waardes die als As in de grafiek dient.

Ik heb al een macro die de gewenste data naar de goede plek kopieert (zie ingebouwde macro).
nu voeg ik elk bestand met de hand in en activeer de macro maar dit zou ik graag geautomatiseerder willen zien. bijvoorbeeld door een X aantal bestanden aan te klikken oid.

zie mijn voorbeeld.

Members only:

Alleen zichtbaar voor ingelogde gebruikers. Inloggen

is dit mogelijk?
zo ja hoe?

alvast bedankt.

Edit:
hopelijk ben ik wat duidelijker zo. heb moeite om me schriftelijk uit te drukken nmlk.

[ Voor 55% gewijzigd door Langerakpc op 13-05-2015 15:35 ]

[BtM909]

Leg nog eens goed uit wat je precies wilt bereiken. Je hebt een voorbeeld Excel bijgevoegd: verwijs dan ook naar de juiste tabbladen en cellen

[Pluistronaut]

Dan zal je toch ook een txt bestand moeten aanleveren, het is namelijk van groot belang hoe die is opgebouwd (komma / tabgescheiden etc.)

[F_J_K]

Dat bestand is blijkbaar via edit al bijgevoegd. (Tip aan de TS: geef dat een volgende keer evt. ook aan in een post, anders ziet niet iedereen dat. We zullen het niet zomaar als 'omhoog kicken' zien )

In het algemeen: ja het kan. Lees alle bestanden uit, leer in een loopje ieder bestand uit en voeg in 1 regel na de laatstgebruikte regel (maar verwijder de regel met de kop, of importeer die niet).

Het is misschien goed om de relevante delen (!) van de code hier te posten. Ik ga in ieder geval geen bestand met code dowloaden en openen vanuit een onvertrouwde bron. En kan je dus zo niet helpen

Let ook op dat de taalinstellingen van VBA altijd VS/Engels is met de betreffende , . ; etc. Ook als je een NL Ofice gebruikt. Houd daar rekening mee. Al gaat het hier om tab delimited files en een tab is een tab. Let ook op de EOLn bij "anti-Stokes -180.250". Dat is geen Windows linebreak (open maar eens in kladblok).

[ Voor 12% gewijzigd door F_J_K op 13-05-2015 15:43 ]

[Langerakpc]

De bestanden zijn inderdaad als tab gescheiden.
Het stuk over stokes en anti stokes wordt niet gebruik alleen de temperatuur.

Hierbij de losse macro die ik al heb om de gegevens te verplaatsen.

Sub Invoeren()
'
' Invoeren Macro
'
' Sneltoets: Ctrl+i
'
Range("H9").Select
Sheets("Blad1").Select
ActiveCell.FormulaR1C1 = "=R[1]C[-6]+R[2]C[-6]"
Range("H9").Select
Selection.Copy
Sheets("ruwe data").Select
Range("A1").Select
Cells(ActiveCell.Row, Selection.End(xlToRight).Column + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blad1").Select
ActiveWindow.SmallScroll Down:=180
Range("B204:B304").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ruwe data").Select
Range("A2").Select
Cells(ActiveCell.Row, Selection.End(xlToRight).Column + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

[Belindo]

Zet je code even tussen code tags. Verder zou ik de code die je net post even opschonen en nakijken, dit lijkt mij de output van record macro? Je hebt nu namelijk stukjes als scrollen ertussen staan, deze zijn overbodig, Ook selecteer je een stukje (B204 tot B304), is deze range altijd hetzelfde? Zo niet, dan moet je dit ook opvangen.

Wbt. het importeren van bestanden, even zonder je bijlages gekeken te hebben zou ik via Import Text de .csv inladen. Vervolgens kun je met VBA steeds een ander bestand inladen en verplaatsen.

Dus:
- Record Macro aan
- 1 CSV inladen op een _temp sheet
- Record Macro uit
- Kijk hoe de ,csv wordt ingeladen, en wat je moet aanpassen om de andere 99 bestanden in te laden
- Schrijf een macro die één voor één de csv inlaadt, opschoont, verplaatst en dan de volgende pakt

Ik zal later even je bijlages bekijken om te zien of ik nog iets meer kan uitdijen.

[Pluistronaut]

Heb even dit voor je gemaakt, werkt bij mij. Maak hiervoor eerst een module aan in de VBA omgeving en plak deze code. Vervolgens draai je éénmaal de macro 'Databladen' om 100 bladen aan te maken.
Om de gegevens te importeren draai je de macro 'Importeren'.

Je oude macro kan je weggooien

Visual Basic:

Sub importeren()

    Sheets("ruwe data").Select

    Range("B1:ZZ393").ClearContents

    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = sPath
        .Title = sTitle
        .AllowMultiSelect = True
         
        If .Show = -1 Then
             ' Open the files
            For lngcount = 1 To .SelectedItems.Count
                
                Call Import(.SelectedItems(lngcount), "DATA" & lngcount)
                
                Sheets("DATA" & lngcount).Range("B204:B304").Copy
                Sheets("ruwe data").Cells(2, lngcount + 1).PasteSpecial Paste:=xlPasteValues
                
                Sheets("ruwe data").Cells(1, lngcount + 1).value = Sheets("DATA" & lngcount).Cells(10, 2).Text & " " & Sheets("DATA" & lngcount).Cells(11, 2).Text
                
            Next lngcount
            
        End If
         
    End With

End Sub

Sub DataBladen()

    Dim ws As Worksheet
    Dim i As Integer

    For i = 1 To 100
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.name = "DATA" & i
    Next

End Sub

Private Sub Import(filename As String, sheetname As String)

    Sheets(sheetname).Cells.Clear
    Sheets(sheetname).Activate

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & filename, _
        Destination:=Range(sheetname & "!$A$1"))
        .name = "20131202oasense 20131203 001 00199_1"
        .FieldNames = True
        .TextFilePlatform = 932
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub

[Langerakpc]

Hij werkt.

dank je super super

[ Voor 98% gewijzigd door Langerakpc op 13-05-2015 16:55 ]

[chead]

Thnx Pluistronaut, ik heb je routine ook ff geleend