• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro tbv ophalen gegevens uit andere excelbestanden

Status
Niet open voor verdere reacties.
A

albundy33

Gebruiker
Lid geworden
8 dec 2008
Berichten
41
Hallo,

ik heb een excel file, met hierin een macro,
die zo functioneert, dat bij het activeren deze macro alle excel-files in een specifieke map opent, hieruit gegevens uit bepaalde cellen ophaalt, en deze vervolgens kopieert en plakt in de excel-file met de macro.

Dit bestand is "Oee Auswertung 17-01 Hoensbroek". Deze macro funtioneert goed, en is ooit door een collega gemaakt.
Omdat ik nu meer informatie uit andere cellen nodig heb, heb ik de macro aangepast naar de benodigde info, deze aangepaste macro staat in "start.xlsm"
De bestanden test 1 , 2 en 3 zijn de bestanden waaruit de gegevens worden opgehaald.
Maar ik krijg de nieuwe macro niet werkend. Bestaden test1-2-3 worden geopend en gelezen, maar de gegevens worden niet geplakt.
Hij geeft echter geen foutmelding. Wie kan me helpen te ontdekken wat ik fout doe?
De info moet worden opgehaald vanaf tabblad 8 uit de testfiles (pareto34), de 1e tabbladen moeten worden genegeerd.
Deze macro moet nog verder worden uitgebreid, omdat er nog meer tabbladen bij moeten komen, dus ik ben ook echt geholpen met uitleg wat ik fout doe,
alleen een aangepaste versie van de macro die wel werkend is zonder uitleg, zal me dan dus niet kunnen helpen, dan zit ik morgen weer met hetzelfde probleem.
Dus wie me wat uitleg kan verschaffen, bij voorbaat al heel erg bedankt.
:thumb:
 

Bijlagen

  • Start.xlsm
    24,3 KB · Weergaven: 40
  • OEE Auswertung 17-01 (Hoensbroek).xlsm
    79,3 KB · Weergaven: 35
  • test 1.xls
    340,5 KB · Weergaven: 19
  • test 2.xls
    336 KB · Weergaven: 12
  • test 3.xls
    336 KB · Weergaven: 12
Het gaat fout bij de voorwaarde:

Code: 
                If ((Cells(n, 1) = Lijn34algemeen) And (Cells(n, 2) = Linie) And (Cells(n, 3) = Datum)) Then _

Pas als aan alle voorwaarde is voldaan worden de gegevens weggeschreven.

Met vriendelijke groet,


Roncancio
 
Het gaat al eerder fout, want hij kijkt naar 2 tabbladen: 8 en 9 (For L = 8 To AnzTabellen). En 9 is leeg. Dus je overschrijft de geplaatste cellen met niks. Overigens kan het een stuk slimmer, door a) de matrix correct te initiëren (een vaste waarde is nooit slim) en b: niet steeds te wisselen tussen werkbladen, maar die aan een variabele toe te wijzen. Krijg je zoiets:
Code: 
Option Base 1

Sub Tagesdateninput()
Dim OEE_Datei()
Dim sPad As String
Dim tarWB As Workbook, srcWB As Workbook
Dim srcWS As Worksheet, tarWS As Worksheet
' einlesen der in den Werken erfassten, täglichen OEE Daten
' die Daten müssen im abgestimmten Format vorliegen

    '-------------------------------------------------
    '  Dateiname abspeichern
    '-------------------------------------------------
    Set tarWB = ActiveWorkbook
    Set tarWS = tarWB.ActiveSheet
    BasisDatei = ActiveWorkbook.Windows(1).Caption
    '-------------------------------------------------
    '  Öffnen der Zieldatei zum Daten-Import
    '  ! ! !    ORDNER ANPASSEN  ! ! !
    '-------------------------------------------------
    ChDrive "D"
    sPad = "D:\OneDrive\_HelpMij\MS Excel\albundy\"
    ChDir sPad
    '-------------------------------------------------
    '  Liest die Dateinamen im entsprechenden Pfad aus
    '  ! ! !    ORDNER ANPASSEN  ! ! !
    '-------------------------------------------------
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(sPad)
    Set fc = f.Files
    anzdateien = 0
    For Each f1 In fc
        anzdateien = anzdateien + 1
        ReDim Preserve OEE_Datei(anzdateien)
        OEE_Datei(anzdateien) = f1.Name
    Next
    '-------------------------------------------------
    '  Erzeugt eine Schleife um alle Dateien zu öffenen
    '-------------------------------------------------
    For Schleife = LBound(OEE_Datei) To UBound(OEE_Datei)
        '-------------------------------------------------
        '  Öffnet die Dateien nacheinander
        '-------------------------------------------------
        If LCase(Left(OEE_Datei(Schleife), 4)) = "test" Then
            Set srcWB = Workbooks.Open(Filename:=OEE_Datei(Schleife))
            Quelldatei = srcWB.Windows(1).Caption
            AnzTabellen = srcWB.Worksheets.Count
            '-------------------------------------------------
            '   Auswahl des ersten Tabellenblattes (alle Tabellenblätter haben das gleiche Format, das letzte ist nicht relevant)
            '-------------------------------------------------
            For L = 8 To AnzTabellen
                
                Set srcWS = srcWB.Worksheets(L)
                '-------------------------------------------------
                '  Auslesen der Basisinformationen
                '  Es wird davon ausgegangen, daß C1 = Werk, D2 = Datum, und I2 = Linie
                '-------------------------------------------------
                Lijn34algemeen = srcWS.Cells(4, 1)
                Datum = srcWS.Cells(3, 4)
                Linie = srcWS.Cells(3, 5)
                '-------------------------------------------------
                '  Erkennen der Datenstruktur
                '  Es wird davon ausgegangen, daß in der Spalte D ( Z0 - Z100) das Wort TOTAAL vorkommt
                '-------------------------------------------------
                For n = 1 To 100
                    If srcWS.Cells(4, n) = "aantalx" Then
                        Ergebnis = n
                        Exit For
                    End If
                Next n
                '-------------------------------------------------
                '  Auslesen der Ergebnisse
                '-------------------------------------------------
                '-------------------------------------------------
                '  Einfügen der Eingelesenen Datein in die Quelldatei
                ' Quali wäre hier die Anzahl den Ausschusses
                '-------------------------------------------------
                If ((Cells(n, 1) = Lijn34algemeen) And (Cells(n, 2) = Linie) And (Cells(n, 3) = Datum)) Then
                    For n = 2 To 200
                        tarWS.Cells(n, 4) = srcWS.Cells(6, Ergebnis)
                        tarWS.Cells(n, 5) = srcWS.Cells(7, Ergebnis)
                        tarWS.Cells(n, 6) = srcWS.Cells(8, Ergebnis)
                        tarWS.Cells(n, 7) = srcWS.Cells(9, Ergebnis)
                        tarWS.Cells(n, 8) = srcWS.Cells(10, Ergebnis)
                        tarWS.Cells(n, 9) = srcWS.Cells(11, Ergebnis)
                    Next n
                End If
            Next L
            Workbooks(Quelldatei).Close SaveChanges:=False
        End If
    Next Schleife
    
End Sub
Maar dat lost het probleem van de lege tabbladen natuurlijk niet op.
 
Bedankt voor je reactie.
Het lege tabblad kan wellicht weg, ik weet neit of die nodig is voor de originele macro, aangezien die nog steeds gebruikt wordt.
In de originele macro staat het als volgt bij dit stukje :

'-------------------------------------------------
' Auswahl des ersten Tabellenblattes (alle Tabellenblätter haben das gleiche Format, das letzte ist nicht relevant)
'-------------------------------------------------
For L = 1 To AnzTabellen - 1
Windows(Quelldatei).Activate
Worksheets(L).Activate
'-------------------------------------------------
' Auslesen der Basisinformationen
' Es wird davon ausgegangen, daß C1 = Werk, D2 = Datum, und I2 = Linie
'-------------------------------------------------
Werk = Cells(1, 3)
Datum = Cells(2, 4)
Linie = Cells(2, 10)

Het stukje -1 heb ik verwijderd uit de nieuwe macro, kan het hieraan liggen?
 
Door -1 weg te laten, kijk je nu in een extra werkblad. En als dat leeg is, dan heb je dus een probleem. Niet met code gaan rommelen als je die niet begrijpt :).
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan