Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Maschinendaten in Datenbank konvertieren
#11
Hallo,

so ist es etwas einfacher:

Code:
Const Pfad As String = "c:\users\xxxxxxxx\desktop\" '<<< anpassen

Sub F_en_V2()

Dim WBQ As Workbook
Dim WQ As Worksheet
Dim WZ As Worksheet
Dim RNG As Range, SP1 As Range, SP2 As Range

Set WZ = Sheets(2)                     '<<<< prüfen (Sheet2 der Beispieldatei)
lr = WZ.Cells(Rows.Count, 1).End(xlUp).Row

f = Dir(Pfad & "*.xlsx")   ' "Papiertige*.xlsx")

Do While Len(f)
    Set WBQ = Workbooks.Open(Pfad & f)
    
    Set WQ = WBQ.Sheets(1)
      
    With WQ.Columns(1)
        .UnMerge
        Set RNG = .Find("Teile-Nr:", , xlValues, xlWhole)
        If Not RNG Is Nothing Then
            Adr = RNG.Address
            Do
               lr = lr + 1
               WZ.Cells(lr, 1) = .Cells(19, 1)
               Set SP1 = RNG.End(xlToRight)
                    
                    SP1.Resize(8).Copy
                    WZ.Cells(lr, 2).PasteSpecial Transpose:=True
                    
               Set SP2 = SP1.End(xlToRight).End(xlToRight)
                    SP2.Resize(5).Copy
                    WZ.Cells(lr, "j").PasteSpecial Transpose:=True
                    
            Set RNG = .FindNext(RNG)
            Loop Until RNG.Address = Adr
        End If
    End With
    WBQ.Close 0

f = Dir
Loop
End Sub

Die Aussage über die Begrenzheit von Forenhilfe bleibt.

mfg
Antworten Top
#12
(13.02.2020, 11:40)Fennek schrieb: Hallo,

so ist es etwas einfacher:

Code:
...

Die Aussage über die Begrenzheit von Forenhilfe bleibt.

mfg


Hallo Fenneck,
Jetzt bin ich mal wieder dazu gekommen. Ich habe den Code an meinen Fall angepasst und bin fast vollständig fertig. Es klappt soweit wie es momentan soll. Vielen Dank!
Um den Vorgang nun noch etwas zu automatisieren / schneller zu gestalten würde ich den Code gerne beliebig oft (gemäß der Anzahl der Dateien in meinem "noch einzupflegen" - Verzeichnis) wiederholen und  

f = Dir(Pfad & "*.xlsx")   

entsprechend automatisch anpassen. Gibt es da Mittel und Wege? Ich denke mir ja, dass für jede Datei in meinem Verzeichnis eine Variable erstellt werden müsste, die er als Zieldatei ansprechen muss um den Code für jede Datei und somit jede Variable zu wiederholen?

Oder ich erstelle eine Eingabespalte mit bspw. 10 Zeilen für Dateinamen, in denen man die Namen der jeweiligen Zieldateien manuell reinkopiert. Neben diese 10 Zeilen lege ich dann je eine Schaltfläche, die zu dem entsprechenden Code - angepasst auf die danebenliegende Quellzelle - passt, um für 10 zu verarbeitende Maschinenprotokolle 10 mal zu klicken.

Machbar oder nicht? 

Ich habe schon etwas versucht, aber bin überfragt, wie ich den Zellinhalt von beispielsweise A2 als Teil von f = Dir(Pfad & "*.xlsx") in die Formel bastel, damit er auch die entsprechende Datei anspricht.

Gruß Papierkrieger
Antworten Top
#13
Hallo,

so wie der Code jetzt ist, werden bei jedem Start ALLE Dateien des Ordners bearbeitet. Um NUR neue Datei einzulesen ist eine kleine Ergänzung notwendig:

NACH dem Einlesen ein Markierung der Datei:

SetAttr Pfad & f, readonly

und VOR der Schleife ein

GetAttr Pfad & f

Sofern das "Readonly" ist wird die Verarbeitung dieser Datei übersprungen.

Ich hoffe, dass das Deine Frage beantwortet.

mfg
Antworten Top
#14
Hallöchen,

Frage A2, z.B.:

f = Dir(Pfad & Range("A2").Value & ".xlsx")


Zitat:und VOR der Schleife ein
GetAttr Pfad & f

Das hätte dann zur Konsequenz, dass es nur bei der ersten Datei was bringt. Und um was zu bewirken, musst Du sicher auch noch eine Bedingung programmieren.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#15
@Andre:

man muss die Befehle und die If-Abfrage schon richtig positionieren.

Aber das soll der Fragesteller einmal versuchen, nur im Notfall, wenn es gar nicht gehen sollte, fahre ich meinen PC deswegen noch einmal hoch.
Antworten Top
#16
so hatte ich es mir vorgestellt:

Code:
Const Pfad As String = "c:\users\xxxxx\desktop\" '<<< anpassen

Sub F_en_V2()

Dim WBQ As Workbook
Dim WQ As Worksheet
Dim WZ As Worksheet
Dim rng As Range, SP1 As Range, SP2 As Range

Set WZ = Sheets(2)                     '<<<< prüfen (Sheet2 der Beispieldatei)
lr = WZ.Cells(Rows.Count, 1).End(xlUp).Row

f = Dir(Pfad & "Papiertige*.xlsx")

Do While Len(f)
    If GetAttr(Pfad & f) <> vbReadOnly Then
        Set WBQ = Workbooks.Open(Pfad & f)
        
        Set WQ = WBQ.Sheets(1)
          
        With WQ.Columns(1)
            .UnMerge
            Set rng = .Find("Teile-Nr:", , xlValues, xlWhole)
            If Not rng Is Nothing Then
                Adr = rng.Address
                Do
                   lr = lr + 1
                   WZ.Cells(lr, 1) = .Cells(19, 1)
                   Set SP1 = rng.End(xlToRight)
                        
                        SP1.Resize(8).Copy
                        WZ.Cells(lr, 2).PasteSpecial Transpose:=True
                        
                   Set SP2 = SP1.End(xlToRight).End(xlToRight)
                        SP2.Resize(5).Copy
                        WZ.Cells(lr, "j").PasteSpecial Transpose:=True
                        
                Set rng = .FindNext(rng)
                Loop Until rng.Address = Adr
            End If
        End With
        WBQ.Close 0
        SetAttr Pfad & f, vbReadOnly
    End If
f = Dir
Loop
End Sub

Zum Testen kann die "If GetAttr" auskommentiert werden, oder mit "SetAttr Pfad & f, vbNormal" zurückgesetzt werden.
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste