Anzeige
Archiv - Navigation
1812to1816
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Dateinamen in Zeilen einfügen

VBA - Dateinamen in Zeilen einfügen
22.02.2021 16:34:15
Adrian
Hallo zusammen,
Ich habe noch eine Herausforderung wo ich aktuell nicht weiter komme und Eure Unterstützung brauche. :-)
Ausgangslage:
Ich habe in einer Zelle (Grunddaten, Zelle D3) einen Pfad definiert, in welchem alle Dateien abgelegt sind.
Diese Zelle ist natürlich variabel anpassbar. In diesem Ordner sind etwa 80 Dateien, welche immer die gleiche Struktur haben.
Nun kann ich aktuell über ein Makro die Inhalte aller Dateien zusammen einfügen in dieser Masterdatei "Version3.xlsm".
Dabei werden die Spaltennamen nur 1x zuoberst eingefügt und die Inhalte unten fortlaufend ergänzt.
Wenn ich den Button erneut klicke, werden die bestehenden Daten wieder gelöscht und die neuen Daten werden wieder eingefügt. Soweit so gut.
Die Datei-Namen sind immer in der gleichen Struktur zusammen gesetzt:
Angebot_"Lieferantenname"_"Lieferantennummer"_"Name der Warengruppe".xlsx
als Beispiel: Angebot_LA_13-1_OG.xlsx
Ziel:
Nun möchte ich gerne zusätzliche Spalten beim Import abfüllen mit diversen Infos aus dem Dateinamen + Verknüpfung mit der Artikelnummer - und das auf jeder Zeile:
als Beispiel:
Angebot_LA_13-1_OG.xlsx
Artikelnummern in der Datei: 10A_01; 10B_01; 10C_01
geplantes Ergebnis
1. Spalte: Angebot_LA_13-1_OG.xlsx
2. Spalte: LA
3. Spalte: 13-1
4. Spalte: OG
5. Spalte 13-1_10A_01 (Verknüpfung aus Lieferantennummer + Artikelnummer
Ich habe mal eine Muster-Datei erstellt.
Bei "Import" ist das aktuelle Makro
Bei "Ziel" so wie es nachher aussehen sollte
Im Ordner "TEMP" sind 4 Dateien zum einfügen.
https://www.herber.de/bbs/user/144151.zip
Hoffe hab dies mal soweit verständlich erklärt :-)
Vielen Dank vorab für Eure Hilfe
Gruss
Adrian

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
22.02.2021 17:16:24
Nepumuk
Hallo Adrian,
teste mal:
Option Explicit

Public Sub DatenLesen()
    
    Dim strFilename As String, strPath As String
    Dim lngStartRow As Long, lngLastRow As Long
    Dim vntTemp As Variant
    Dim objWorksheet As Worksheet
    Dim objWorkbook As Workbook
    
    Application.ScreenUpdating = False
    
    strPath = ThisWorkbook.Worksheets("GrundDaten").Range("D3").Value
    
    If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
    
    Set objWorksheet = ThisWorkbook.Worksheets("Import")
    
    With objWorksheet
        Call .Range(.Cells(5, 4), .Cells(.Rows.Count, 15)).ClearContents
    End With
    
    strFilename = Dir$(strPath & "*.xlsx")
    
    Do Until strFilename = vbNullString
        
        vntTemp = Split(strFilename, "_")
        
        Set objWorkbook = GetObject(PathName:=strPath & strFilename)
        
        With objWorkbook.Worksheets(1)
            
            Call .Range(.Cells(2, 1), .Cells(.Rows.Count, 7).End(xlUp)).Copy
            
        End With
        
        With objWorksheet
            
            Call .Cells(.Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial(Paste:=xlPasteValues)
            
            lngStartRow = .Cells(.Rows.Count, 4).End(xlUp).Offset(1, 0).Row
            
            lngLastRow = .Cells(.Rows.Count, 9).End(xlUp).Row
            
            .Range(.Cells(lngStartRow, 4), .Cells(lngLastRow, 4)).Value = strFilename
            
            .Range(.Cells(lngStartRow, 5), .Cells(lngLastRow, 5)).Value = vntTemp(1)
            
            .Range(.Cells(lngStartRow, 6), .Cells(lngLastRow, 6)).Value = vntTemp(2)
            
            .Range(.Cells(lngStartRow, 7), .Cells(lngLastRow, 7)).Value = vntTemp(3)
            
            .Range(.Cells(lngStartRow, 8), .Cells(lngLastRow, 8)).FormulaR1C1 = "=RC[-2]&""_""&RC[1]"
            
        End With
        
        Call Workbooks(strFilename).Close(SaveChanges:=False)
        
        strFilename = Dir$
        
    Loop
    
    With objWorksheet
        
        With .Range(.Cells(5, 8), .Cells(.Rows.Count, 8).End(xlUp))
            
            .Value = .Value
            
        End With
    End With
    
    Set objWorkbook = Nothing
    Set objWorksheet = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

Gruß
Nepumuk
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
23.02.2021 08:19:55
Adrian
Hallo Nepumuk,
Vielen Dank für einen Code.
Habe Ihn eben ausprobiert - der setzt alles richtig zusammen! :-)
Das klappt ja wunderbar!!
2 Fragen noch:
Wird dieser Teil des Codes noch benötigt?
With objWorksheet
With .Range(.Cells(5, 8), .Cells(.Rows.Count, 8).End(xlUp))
.Value = .Value
End With
End With
Die eingefügten Daten will ich nachher mit einer INDEX Funktion auswerten.
Hast Du mir einen Vorschlag wie ich die eingefügten Daten als Bereich markieren kann?
Wenn die Daten am Anfang alle gelöscht werden, geht logischerweise auch der Bereich verloren.
Diesen müsste man dann immer wieder erzeugen mit dem gleichen Namen.
Oder gibt es dafür einen kürzeren Weg?
Gruss
Adrian
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
23.02.2021 09:51:06
Nepumuk
Hallo Adrian,
1. Mit diesem Codeteil werden die eingesetzten Formeln in Werte umgewandelt. Das kannst du auch weg lassen.
2. Um einem Bereich einen Namen zu geben ist es nicht notwendig diesen zu markieren.
Gruß
Nepumuk
AW: VBA - Dateinamen in Zeilen einfügen
23.02.2021 10:13:10
Adrian
Hallo Nepumuk,
1. Danke fürs erklären
2. Wie bilde ich dies im VBA ab?
Ich muss ja einen Range angeben wenn ich einen Bereichsnamen erzeuge
Dieser Range kann ja immer wieder anders sein, von der Zeilenanzahl her.
Wenn ich mehr Dateien für den Import habe, bekomme ja auch mehr Zeilen...
Gruss
Adrian
AW: VBA - Dateinamen in Zeilen einfügen
23.02.2021 10:19:27
Nepumuk
Hallo Adrian,
so:
With objWorksheet
    
    With .Range(.Cells(5, 8), .Cells(.Rows.Count, 8).End(xlUp))
        
        .Value = .Value
        
    End With
    
    .Range(.Cells(5, 4), .Cells(.Rows.Count, 15).End(xlUp)).Name = "MeinName" ' Name anpassen !!!
    
End With

Gruß
Nepumuk
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
23.02.2021 12:10:34
Adrian
Hallo Nepumuk,
Danke Dir :-)
Und hab immer ".Add Name" herumexperimentiert...
Ich habe nun sogar den Code erweitert und alle Spalten entsprechend noch je in einem Bereich definiert.
    .Range(.Cells(6, 4), .Cells(.Rows.Count, 15).End(xlUp)).Name = "Import_Tabelle"
.Range(.Cells(6, 4), .Cells(.Rows.Count, 4).End(xlUp)).Name = "Import_Pfad"
.Range(.Cells(6, 5), .Cells(.Rows.Count, 5).End(xlUp)).Name = "Import_Lieferant"
.Range(.Cells(6, 6), .Cells(.Rows.Count, 6).End(xlUp)).Name = "Import_LieferantN"
.Range(.Cells(6, 7), .Cells(.Rows.Count, 7).End(xlUp)).Name = "Import_WG"
.Range(.Cells(6, 8), .Cells(.Rows.Count, 8).End(xlUp)).Name = "Import_Verketten"
Habe mir dann noch einen weiteren Schritt überlegt:
Gerne würde ich die Namen der Bereiche so gestallten, dass diese zusammengesetzt sind aus:
"Blattnamen_Spaltenüberschirft"
Da die Tabelle dann recht gross - erhöht dies dann auch die Übersicht :-)
Danke Dir nochmals vorab für Deine tolle Hilfe
Wirklich toll, dass dies so schnell klappt :-)
Gruss
Adrian
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
23.02.2021 12:31:22
Nepumuk
Hallo Adrian,
dann so:
With objWorksheet
    
    With .Range(.Cells(5, 8), .Cells(.Rows.Count, 8).End(xlUp))
        
        .Value = .Value
        
    End With
    
    .Range(.Cells(6, 4), .Cells(.Rows.Count, 15).End(xlUp)).Name = .Name & "_Tabelle"
    .Range(.Cells(6, 4), .Cells(.Rows.Count, 4).End(xlUp)).Name = .Name & "_" & .Cells(5, 4).Text
    .Range(.Cells(6, 5), .Cells(.Rows.Count, 5).End(xlUp)).Name = .Name & "_" & .Cells(5, 5).Text
    .Range(.Cells(6, 6), .Cells(.Rows.Count, 6).End(xlUp)).Name = .Name & "_" & .Cells(5, 6).Text
    .Range(.Cells(6, 7), .Cells(.Rows.Count, 7).End(xlUp)).Name = .Name & "_" & .Cells(5, 7).Text
    .Range(.Cells(6, 8), .Cells(.Rows.Count, 8).End(xlUp)).Name = .Name & "_" & .Cells(5, 8).Text
    
End With

Gruß
Nepumuk
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
23.02.2021 12:54:44
Adrian
Hey Nepumuk,
Vielen herzlichen Dank!!!
Genial!!!
Habe nun noch selber die Kopfzeilen als Bereich ergänzt und es hat funktioniert:
.Range(.Cells(5, 4), .Cells(5, 15)).Name = .Name & "_Kopfzeilen"

Jetzt kann ich versuchen, dass ganze in die grosse Tabelle zu integrieren. Das solte ich aber dann hinbekommen...
Gruss
Adrian
AW: VBA - Dateinamen in Zeilen einfügen
24.02.2021 15:53:17
Adrian
Hallo Nepumuk
Ich habe mittlerweile dass ganze in eine grössere Tabelle integriert.
Habe auch noch Variablen ergänzt bezüglich Startzelle.
Nun habe ich noch 3 Punkte, welche ich nicht verstehe.
Bei Einfügen der Daten kommt jetzt immer die Info, dass der Zwischenspeicher voll ist.
Kann ich dies umgehen, dass er zwischendurch den Speicher wieder leert?
Im unteren Bereich des VBA werden ja noch automatisch Bereiche erzeugt.
Des erste Bereich soll dann für A101 bis X-"letzte Zeile" gehen.
Es wird aber dann die Zeile 100 auch ausgewählt - verstehe ich leider nicht warum ?!
Dann weiter ist mir noch aufgefallen, dass dort wo der Dateiname gesplittet wird, am Schluss die Endung noch mitkommt. Habe dies kurzfristig mit eine Left() gelöst.
Hat man dort die Möglichkeit die Split-Funktion noch zu erweitern?
Anbei die Musterdatei
https://www.herber.de/bbs/user/144214.zip
Danke nochmals vorab
Gruss
Adrian
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
24.02.2021 17:01:20
Nepumuk
Hallo Adrian,
1. Dann muss die Zwischenablage geleert werden.
2. Du suchst die letzte Zeile in Spalte 24. Die ist aber bis auf die Überschrift leer.
3. Dann musst du am Punkt nochmal splitten und nur den ersten Teil in die Zellen schreiben.
Teste mal:
Option Explicit

Public Sub DatenImport()
    
    Const Start_Z As Long = 101 'Start Zeilennummer
    Const Start_S As Long = 1 'Start Spaltennummer
    Const Ende_S As Long = 23 'Ende Spaltennummer
    
    Dim strFilename As String, strPath As String
    Dim lngStartRow As Long, lngLastRow As Long
    Dim vntTemp As Variant
    Dim objWorksheet As Worksheet
    Dim objWorkbook As Workbook
    
    'Application.ScreenUpdating = False
    
    strPath = ThisWorkbook.Worksheets("Import").Range("A5").Value 'Speicherort aller Excel-Angebote
    
    If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
    
    Set objWorksheet = ThisWorkbook.Worksheets("Import") 'Tabellenname bei der die Daten eingefügt werden
    'Formel müssen auch angepasst werden bei allen Folgetabellen
    
    With objWorksheet
        Call .Range(.Cells(Start_Z, Start_S), .Cells(.Rows.Count, Ende_S)).ClearContents
    End With
    
    strFilename = Dir$(strPath & "*.xlsx")
    
    Do Until strFilename = vbNullString
        
        vntTemp = Split(strFilename, "_")
        
        Set objWorkbook = GetObject(PathName:=strPath & strFilename)
        
        With objWorkbook.Worksheets(1)
            
            Call .Range(.Cells(2, 1), .Cells(.Rows.Count, 20).End(xlUp)).Copy
            
        End With
        
        With objWorksheet
            
            Call .Cells(.Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial(Paste:=xlPasteValues)
            
            Application.CutCopyMode = False
            
            lngStartRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            
            lngLastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
            
            .Range(.Cells(lngStartRow, 1), .Cells(lngLastRow, 1)).Value = strFilename
            .Range(.Cells(lngStartRow, 2), .Cells(lngLastRow, 2)).Value = vntTemp(1)
            .Range(.Cells(lngStartRow, 3), .Cells(lngLastRow, 3)).Value = Split(vntTemp(3), ".")(0)
            .Range(.Cells(lngStartRow, 4), .Cells(lngLastRow, 4)).FormulaR1C1 = "=Left(RC[-1], 4)&"";""&RC[1]"
            '.Range(.Cells(lngStartRow, 4), .Cells(lngLastRow, 4)).Value = vntTemp(2)
            '.Range(.Cells(lngStartRow, 7), .Cells(lngLastRow, 7)).Value = vntTemp(3)
            
            
        End With
        
        Call Workbooks(strFilename).Close(SaveChanges:=False)
        
        strFilename = Dir$
        
    Loop
    
    
    With objWorksheet
        
        With .Range(.Cells(Start_Z, 1), .Cells(.Rows.Count, 4).End(xlUp))
            
            .Value = .Value
            
        End With
        
        .Range(.Cells(Start_Z, 1), .Cells(.Rows.Count, Ende_S).End(xlUp)).Name = .Name & "_Tabelle"
        '.Range(.Cells(Start_Z, 1), .Cells(.Rows.Count, 1).End(xlUp)).Name = .Name & "_" & .Cells(100, 1).Text
        '.Range(.Cells(Start_Z, 5), .Cells(.Rows.Count, 5).End(xlUp)).Name = .Name & "_" & .Cells(5, 5).Text
        '.Range(.Cells(Start_Z, 6), .Cells(.Rows.Count, 6).End(xlUp)).Name = .Name & "_" & .Cells(5, 6).Text
        '.Range(.Cells(Start_Z, 7), .Cells(.Rows.Count, 7).End(xlUp)).Name = .Name & "_" & .Cells(5, 7).Text
        '.Range(.Cells(Start_Z, 8), .Cells(.Rows.Count, 8).End(xlUp)).Name = .Name & "_" & .Cells(5, 8).Text
        '.Range(.Cells(5, 4), .Cells(5, 15)).Name = .Name & "_Kopfzeilen"
        
    End With
    
    'Range("D2").Select
    
    'Application.ScreenUpdating = True
    
End Sub

Gruß
Nepumuk
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
24.02.2021 20:27:12
Adrian
Hallo Nepumuk,
Danke für deine schnelle Hilfe!
Ist mir jetzt verständlich, wieso das nicht funktioniert hat :-)
Zu Punkt 2 hätte ich noch folgende Anpassung:
Die Grösse der Tabelle - bzw. die Anzahl der Spalten bleibt immer gleich.
Es kann aber durchaus vorkommen, dass zum Beispiel die letzten beiden Spalten leer - dann würde es ja auch nicht funktionieren.
Folgende Idee:
Kann man bei einer definierten (variablen) Spalte vorab die Zeilenanzahl ermitteln und dies als Variable einsetzten bei allen anderen Spalten, wenn man Bereiche erzeugt?
1. bis 5. Spalte ist immer komplett voll.
Bedeutet dann auch, dass der Bereich für die ganze Tabelle dann immer von
A101 bis X"ermittelter Wert" geht.
Kannst Du mir folgen? :-)
Gruss
Adrian
Anzeige
AW: VBA - Dateinamen in Zeilen einfügen
24.02.2021 20:37:17
Nepumuk
Hallo Adrian,
so:
.Range(.Cells(Start_Z, 1), .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row, Ende_S)).Name = .Name & "_Tabelle"
Gruß
Nepumuk
AW: VBA - Dateinamen in Zeilen einfügen
24.02.2021 22:42:34
Adrian
Hallo Nepumuk,
Herzlichen Dank !!! :-)
Hat auf Anhieb geklappt.
Die anderen Bereiche kann ich dann ohne weiteres noch selber ergänzen...
Bau dann noch 1-2 Variablen ein, damit es etwas einfacher geht für eine spätere Anpassung.
Da immer nur die Inhalte gelöscht werden, kann ich die Formate der Spalten auch FIX vergeben.
Und diese bleiben dann auch erhalten
Ist mir eben gerade aufgefallen :-)
Riesen Dank an Dich!!!
Gruss
Adrian
Anzeige

327 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige