Office: Makro mit variierenden Dateinamensendungen

Hallo,

ich bin leider absoluter Beginner und hoffe mich mit meiner Frage nicht total zu blamieren - vielleicht ist ja wirklich nur eine Kleinigkeit. Bin hie rund in anderen Foren leider nicht fündig geworden.

Hier kurz der Sachverhalt:

Ich habe ein Makro (Excel 2010) aufgenommen. Dort werden:
1. zwei CSV Dateien in zwei seperaten workbooks mit jeweils einem sheet geöffnet
2. ein sheet wird zum anderen bewegt - somit gibt es dann nur noch ein workbook mit zwei sheets
3. es finden ein paar Berechnungen statt (soll hier nicht weiter erläutert werden)
4. das workbook wird abgespeicht

Mein Problem:
1. Da ich die CSV Dateien ja manuell ausgewählt habe, funktioniert das Makro nicht mehr, sobald ich zwei andere Dateinamen verwende (logisch). Die Dateien variieren allerdings nur in ihrer Endung (z.B.: getContent_2014-06-19.csv oder _2014-06-20.csv). ich hatte versucht diese Datumsendung mit einem "*" zu esetzten, aber funktioniert so leider nicht. Es gibt doch bestimmt eine Möglichkeit die Endung offen zu lassen?!
2. Ich habe eine Formel (VLOOKUP bzw. SVERWEIS auf deutsch), welche auch mit einem zweiten sheets arbeitet. Hier ist genau das gleiche Problem. Die Formel soll trotz sich ändernder Datumsendung die Berechnugn ausführen.

Hier mein code:

Sub Merge()

' Merge Macro

Workbooks.Open Filename:= _
"N:\lounge\19 Business Intelligence\AB Test\Webtrekk Tables\DE\Felix Test\getContents_2014-06-19.csv"
Workbooks.Open Filename:= _
"N:\lounge\19 Business Intelligence\AB Test\Webtrekk Tables\DE\Felix Test\getFullCustomer_2014-06-19.csv"
Sheets("getFullCustomer_2014-06-19").Select
Sheets("getFullCustomer_2014-06-19").Move After:=Workbooks( _
"getContents_2014-06-19.csv").Sheets(1)
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
Columns("B:B").Select
Selection.Cut
Columns("E:E").Select
ActiveSheet.Paste
Range("E:E,D:D").Select
Range("D1").Activate
Selection.NumberFormat = "0.00"
Sheets("getContents_2014-06-19").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
TrailingMinusNumbers:=True

Columns("B:B").Select
Selection.NumberFormat = "0.00"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Customer ID"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-5],'getFullCustomer_2014-06-19'!C[-3]:C[-2],2,0)"
Selection.AutoFill Destination:=Range("G2:G230591")
Range("G2:G230591").Select
ChDir "N:\lounge\19 Business Intelligence\AB Test\Webtrekk Tables\DE\Final"
ActiveWorkbook.SaveAs Filename:= _
"N:\lounge\19 Business Intelligence\AB Test\Webtrekk Tables\DE\Final\getContents_2014-06-19.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

Vielen Dank falls mir da einer helfen kann! ...und natürlich ein frohes Fest!

fex82

PS: Ist alles total einfach - wenn man weiß wie ;-)

 

Hallo,

und hier ist mein modifizierter VBA-Code:

Code:

Option Explicit

Sub Merge()

 Dim BasisPfad As String, InputPfad As String, OutputPfad As String
 Dim Dateien As FileDialogSelectedItems
 Dim ArbMappe(1 To 3) As String, ArbBlatt(1 To 2) As String
 
'---- Die Dateipfade ---------------
' Im "InputPfad" wird nach den 2 auszuwählenden CSV-Dateien gesucht im Dateidialogfenster;
' Im "OutputPfad" wird die fertige *.xlsx-Datei gespeichert
 BasisPfad = "N:\lounge\19 Business Intelligence\AB Test\Webtrekk Tables\DE\"
 InputPfad = BasisPfad & "Felix Test\"
 OutputPfad = BasisPfad & "Final\"
'----
 Set Dateien = CSVDateienAuswahl(InputPfad)
 If Dateien Is Nothing Then Exit Sub  'Keine Datei ausgewählt
 If Dateien.Count <> 2 Then Exit Sub  'Es müssen genau 2 Dateien ausgewählt werden!!
'----
 With Workbooks
   .Open Filename:=Dateien(1) 'getContents....csv
   ArbMappe(1) = ActiveWorkbook.Name
   .Open Filename:=Dateien(2) 'getFullCustomer....csv
   ArbMappe(2) = ActiveWorkbook.Name
 End With
 ArbBlatt(1) = Left(ArbMappe(1), InStrRev(ArbMappe(1), ".") - 1)
 ArbBlatt(2) = Left(ArbMappe(2), InStrRev(ArbMappe(2), ".") - 1)
 ArbMappe(3) = ArbBlatt(1) & ".xlsx"
 
'----ArbBlatt(2)
 Sheets(ArbBlatt(2)).Select
 Sheets(ArbBlatt(2)).Move After:=Workbooks(ArbMappe(1)).Sheets(1)
 Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
   TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
   Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
   FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
   
 Columns("B:B").Cut
 Columns("E:E").Select
 ActiveSheet.Paste
 
 Range("D:E").NumberFormat = "0.00"
 Range("D1").Activate
 
'----ArbBlatt(1)
 Sheets(ArbBlatt(1)).Select
 Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
   TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
   Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
   FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True

 Columns("B:B").NumberFormat = "0.00"
 Range("G1").FormulaR1C1 = "Customer ID"
 Range("G2:G230591").FormulaR1C1 = Replace("=VLOOKUP(RC[-5],'ArbBlatt'!C[-3]:C[-2],2,0)", "ArbBlatt", ArbBlatt(2))
 
'----ArbMappe(3)
 ChDir OutputPfad
 ActiveWorkbook.SaveAs Filename:=OutputPfad & ArbMappe(3), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
'
'Der CSV-Dateidialog:
'1) Ausgehend vom Anfangsverzeichnis "Pfad" 2 CSV-Dateien ausgewählen
'2) Button "Auswählen 2 Dateien" klicken
'
Function CSVDateienAuswahl(Pfad As String) As FileDialogSelectedItems
  
  With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = Pfad
    .InitialView = msoFileDialogViewDetails
    .AllowMultiSelect = True
    .ButtonName = "Auswählen 2 Dateien"
    .Title = "Auswahl von 2 CSV-Dateien"
    .Filters.Clear
    .Filters.Add "CSV-Dateien", "*.CSV", 1
    Set CSVDateienAuswahl = Nothing
    If .Show Then
      If .SelectedItems.Count = 2 Then
        Set CSVDateienAuswahl = .SelectedItems
      End If
    End If
  End With
  
End Function

Nach dem Start des Makros "Merge" wird ein Dateidialogfenster eingeblendet, das nur die CSV-Dateien im Verzeichnis "N:\...\Felix Test\" auflistet (Variable "InputPfad"). Es müssen 2 CSV-Dateien markiert werden und dann der Button "Auswählen 2 Dateien" angeklickt werden. Falls nicht genau 2 Dateien ausgewählt wurden (zB. keine oder nur eine oder drei etc), wird das Makro kommentarlos abgebrochen.
Falls genau 2 CSV-Dateien ausgewählt waren, wird das Makro fortgesetzt, so wie es Deine Makrovorgabe vorsah. Es kommt somit natürlich auch auf die Reihenfolge der Dateiauswahl an, welche Datei wie weiterbehandelt wird.
Das Ergebnis der Dateimanipulation wird dann, genau wie in deinem Makro vorgesehen, in Verzeichnis "OutputPfad" als *.xlsx-Datei gespeichert.
Diese vorgegebenen Pfade können natürlich im Makro geändert werden; diese Stelle im Makro habe ich deutlich durch Kommentar gekennzeichnet.

 

Hi Anton,

ich kann nur sagen: Tausend Dank!!! Ich schaue mir alles in Ruhe an und werde bestimmt das Meiste nachvollziehen können, dank Deiner Kommentare! Echt super!!!

Viele Grüße und Guten Rutsch!