TXT Dateien öffnen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: TXT Dateien öffnen
von: Christoph Zahn
Geschrieben am: 20.09.2015 10:00:33

Hallo ich habe folgendes Problem
ich möchte gerne mehrere TXT-Dateien importieren.
Habe folgendes mit den Recorder aufgenommen.

Sub Makro32()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\acer\Desktop\512801200\Einnahmen\report.txt", Destination:= _
        Range("$A$1"))
        .CommandType = 0
        .Name = "report"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
End Sub
wäre es möglich das man zum Anfang einen Ordner auswählt, in dem sich die Dateien befinden und das Makro nach und nach alle importiert? Für jede TXT Datei soll ein neue ExcelDatei verwendet werden.
Die Form der fortlaufenden Report-Dateien ist: report(x).txt außer die erste die enthält keine Klammern.
Außerdem wäre es gut wenn die Dateinamen der neuen excel Dateien den Namen aus einer anderen Exceltabelle ziehen.
01.06.2015
02.06.2015
04.06.2015
08.06.2015
09.06.2015
11.06.2015
15.06.2015
16.06.2015
18.06.2015
22.06.2015
23.06.2015
25.06.2015
29.06.2015
30.06.2015
Diese Namen befinden sich in "Überblick Einnahmen.xlsx" im Tabellenblatt "Tabelle1" und ab Spalte A2 abwärts.
Beispiel wäre dann report.txt wird in Exceldatei kopiert und bekommt den Namen 01.06.2015
report(1).txt bekommt den Namen 02.06.2015
usw
hoffe habe mein Problem verständlich erklärt.
Falls Exceldateien benötigt werden einfach melden.
mfg Christoph

Bild

Betrifft: AW: TXT Dateien öffnen
von: fcs
Geschrieben am: 20.09.2015 12:51:57
Hallo Christoph,
ich hab das soweit umsetzen können. Es wahr aber mühsehlig, die Report-Dateien den Excel-Dateinamen korrekt zuzuordnen. Letztendlich habe ich es anders herum gemacht, da die Reihenfolge der Exceldateinamen bekannt ist, die Reihenfolge der Report-Dateien beim Öffnen aber nicht.
Textdatei mit ergänztem Makro.
https://www.herber.de/bbs/user/100279.txt
Du musst ggf. noch ein paar Anpassungen machen
- Datumsformat im Dateinamen
- Blattname in den generierten Dateien
- Verzeichnis für die generierten Excel-Dateien
Gruß
Franz

Bild

Betrifft: AW: TXT Dateien öffnen
von: Christoph Zahn
Geschrieben am: 20.09.2015 14:26:31
klappt so wie ich mir das vorstell.
ich danke dir!
jetzt habe ich noch eine frage.
kann ich diesen Code irgendwie mit einfügen das bevor diese Datei gespeichert wird dieser noch abgearbeitet wird?
Ich weiß das der Code nicht gerade professionell ist.


Sub Bearbeiten()
  
     
       Range("J4").Select
           ActiveCell.FormulaR1C1 = "MwSt-Satz"
            Range("J5").Select
  ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(RC[-5]=""Artikelpreis"",(IF(LEFT(1)=""M"",""19%"",""7%"")),""""),"""")"
       Range("I5").Select
        Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    
    Dim L As Long
For L = 1 To Range("E65536").End(xlUp).Row
   If Cells(L, 5).Value = "Aktionsrabatt" Then
   Range("A1:J1").EntireColumn.Delete
   Exit Sub
   End If
Next
    Columns("J:J").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Dim Ez As Long    'erste Zeile (hast Du vorgegeben)
    Dim Lz As Long    'letzte Zeile (wird ermittelt)
    Dim Spalte As String
    Spalte = "A"
    Ez = 4      'Vorgabe
    Lz = ActiveSheet.Cells(Rows.Count, Spalte).End(xlUp).Row  'ermitellt letzte Zeile
ActiveSheet.Range(Spalte & Ez & ":K" & Lz).Select
 Selection.Sort Key1:=ActiveCell.Offset(0, 9), _
  Order1:=xlDescending, _
  DataOption1:=xlSortNormal, _
  Key2:=ActiveCell.Offset(0, 2), _
  Order2:=xlDescending, _
  DataOption2:=xlSortNormal, _
  Header:=xlYes, _
  MatchCase:=False, _
  Orientation:=xlTopToBottom
  
         Range("A2").Select
  
       Selection.End(xlDown).Select
    ActiveCell.Offset(2, 0).Select
       ActiveCell.FormulaR1C1 = "Gesamt"
          ActiveCell.Offset(0, 1).Select
          ActiveCell.FormulaR1C1 = "=SUM(R[-715]C[5]:R[999283]C[5])"
          
      ActiveCell.Offset(1, -1).Select
          ActiveCell.FormulaR1C1 = "Gebühren"
                 ActiveCell.Offset(0, 1).Select
             ActiveCell.FormulaR1C1 = "=SUMIF(C[3],""Amazon-Gebühren"",C[5])"
                 ActiveCell.Offset(1, -1).Select
          ActiveCell.FormulaR1C1 = "7%"
            ActiveCell.Offset(0, 1).Select
             ActiveCell.FormulaR1C1 = "=SUMIF(C[8],""7""%,C[5])"
               ActiveCell.Offset(1, -1).Select
          ActiveCell.FormulaR1C1 = "19%"
          ActiveCell.Offset(0, 1).Select
              ActiveCell.FormulaR1C1 = "=SUMIF(C[8],""19%"",C[5])"
          Cells.Select
          Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   End Sub


Bild

Betrifft: AW: TXT Dateien öffnen
von: Christoph Zahn
Geschrieben am: 20.09.2015 15:39:39
frage noch offen. hatte häckchen vergessen.

Bild

Betrifft: AW: TXT Dateien öffnen
von: Christoph Zahn
Geschrieben am: 20.09.2015 19:41:30
Hallo ich nochmal.
Ist dies nicht so einfach dieses Code mit einzupflegen?
Ich hab schon versucht diesen Code an 2-3 Stellen einzufügen aber dann läuft das Makro nicht durch.
Wie gesagt möchte eigentlich, dass mein 2. Makro bei jeder eingefügten TXT Datei in Excelformat durchläuft bevor diese gespeichert und geschlossen wird.

Bild

Betrifft: AW: TXT Dateien öffnen
von: Christoph Zahn
Geschrieben am: 20.09.2015 23:11:56
Hallo
Ich nochmal.
Bin jetzt schon etwas weiter gekommen.
Habe es etwas über Umwege gemacht indem ich nochmal die Exceltabellen die endstanden sind nochmal öffne und das Makro durch eine Schleife bei jeder Anwende.
Option Explicit
Const strPath As String = "C:\Users\acer\Desktop\512801200\Einnahmen\"

Sub Main()
    Dim strDateiname As String
    Dim wkbBook As Workbook
    Dim lngLastRowQ As Long
    Dim lngLastRowZ As Long
    Dim lngLastCol As Long
    Dim intCalc As Integer
    On Error GoTo Fin
    With Application
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .EnableEvents = False
        intCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")
    strDateiname = Dir$(strPath & "*.xlsx")
    Do While strDateiname <> ""
        If strDateiname <> ThisWorkbook.Name Then
            Set wkbBook = Workbooks.Open(strPath & strDateiname)
        Call Bearbeiten
        
            wkbBook.Close True ' Oder True, wenn gespeichert werden soll
            Set wkbBook = Nothing
        End If
        strDateiname = Dir$()
    Loop
Fin:
    Set wkbBook = Nothing
    With Application
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = intCalc
        .DisplayAlerts = True
    End With
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
So siehts dann aus.
Das Makro "Bearbeiten" welches ich über Call aufrufe, enthält folgende Code-Zeilen
Range("J1").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-5]=""Artikelpreis"",IF(LEFT(RC[-7],1)=""M"",""19%"",""7%""),"""")"
Range("I2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Leider steht zum Schluss diese Formel nicht in J1 und abwärts.
Lasse ich Das Makro Bearbeiten aber über eine einzelne Tabelle manuell laufen funktioniert alles wie es soll.
Weiß jemand Rat?
Gruß Christoph

Bild

Betrifft: AW: TXT Dateien öffnen
von: fcs
Geschrieben am: 21.09.2015 08:17:43
Hallo Christoph,
die Einbindung des zusätzlichen Makros müßte etwa wie folgt erfolgen.
Es kann aber sein, dass das Laden der Daten aus der Textdatei irgendwie nicht schnell genug funktioniert. Deshalb das zusätzliche RefreshAll.

            Application.DisplayAlerts = False 'ggf. vorhandene Exceldatei _
                    wird überschrieben
            wkbText.RefreshAll
            Call Bearbeiten
            
Das Problem mit der Formel: ? Entweder wird die letzte Zeile nicht korrekt ermittelt oder vor dem Ersetzen der Formeln durch ihre Werte muss die Datei noch neu berechent werden
Application.Calculate
Ich hab mir dein Makro mal angesehen. Versuche es mal mit der nachfolgenden Variante.
Ein paar Spalten-Nummern muss du ggf. noch korrigieren. Bei vielen Select- und ActiveCell-Anweisungen verliert man schon mal den Überblick. Die Formeln werden noch nicht durch Werte erstzt. Die entsprechenden Zeilen sind noch als Kommentare enthalten
Gruß
Franz
Sub Bearbeiten()
  
   Dim Zeile As Long
   Dim L As Long, wks As Worksheet
   Set wks = ActiveSheet
   With wks
        With .UsedRange
            Zeile = .Row + .Rows.Count - 1
        End With
        
        .Range("J4").FormulaR1C1 = "MwSt-Satz"
        'Formel in Spalte J
        .Range(.Cells(5, 10), .Cells(Zeile, 10)).FormulaR1C1 = _
            "=IFERROR(IF(RC[-5]=""Artikelpreis""," _
            & "(IF(LEFT(RC[-7],1)=""M"",""19%"",""7%"")),""""),"""")"
        
        For L = 1 To Zeile
            If .Cells(L, 5).Value = "Aktionsrabatt" Then
                .Range("A1:J1").EntireColumn.Delete
                Exit Sub
            End If
        Next
        
        With .Columns("J:J")
            .Copy
'            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
        End With
        Application.CutCopyMode = False
        Dim Ez As Long    'erste Zeile (hast Du vorgegeben)
        Dim Lz As Long    'letzte Zeile (wird ermittelt)
        Dim Spalte As Long
        Spalte = 1    'Spalte A
        Ez = 4        'Vorgabe
        Lz = .Cells(.Rows.Count, Spalte).End(xlUp).Row  'ermitellt letzte Zeile
        'Daten Spalten A bis K ab Zeile 4 sortieren nach Spalte J und C
        With .Range(.Cells(Ez, Spalte), .Cells(Lz, 11))
            .Sort _
            Key1:=.Cells(1, 10), Order1:=xlDescending, DataOption1:=xlSortNormal, _
            Key2:=.Cells(1, 3), Order2:=xlDescending, DataOption2:=xlSortNormal, _
            Header:=xlYes, _
            MatchCase:=False, _
            Orientation:=xlTopToBottom
        End With
        
        .Cells(Lz + 2, 1).Value = "Gesamt"
        
        .Cells(Lz + 2, 2).FormulaR1C1 = "=SUM(R" & (Ez + 1) & "C[5]:R[-2]C[5])"
                
        .Cells(Lz + 3, 1).Value = "Gebühren"
        
        .Cells(Lz + 3, 2).FormulaR1C1 = "=SUMIF(C[3],""Amazon-Gebühren"",C[5])"
        
        .Cells(Lz + 4, 1).Value = "7%"
        
        .Cells(Lz + 4, 2).FormulaR1C1 = "=SUMIF(C[8],""7""%,C[5])"
        
        .Cells(Lz + 5, 1).Value = "19%"
        
        .Cells(Lz + 5, 2).FormulaR1C1 = "=SUMIF(C[8],""19%"",C[5])"
        'Zellen mit Summenformeln durch Werte ersetzen
        With .Range(.Cells(Lz + 2, 2), .Cells(Lz + 5, 2))
          .Calculate
          '.Value = .Value
        End With
    End With
End Sub


Bild

Betrifft: AW: TXT Dateien öffnen
von: Christoph Zahn
Geschrieben am: 21.09.2015 23:47:55
Danke dir mal wieder.
Habe das Makro jetzt so angepasst das es für meine Anwendung funktioniert.
andere Frage noch kann ich für die Ordnerauswahl auch einen festen Pfad in das Makro einpflegen ohne das ich diesen aussuchen muss?
Ist immer der gleich Pfad!

Bild

Betrifft: AW: TXT Dateien öffnen
von: fcs
Geschrieben am: 22.09.2015 08:21:36
Hallo Christoph,
ersetze

    'Auswahl-Dialog für Ordner anzeigen
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Bitte Verzeichnis/Ordner mit den report-Text-Dateien auswählen"
        If .Show = -1 Then
            strPfad_txt = .SelectedItems(1)
        Else
            GoTo Beenden
        End If
    End With

durch
    'Ordner mit den Text-Dateien
    strPfad_txt = "C:\Test\MeinVerzeichnis" 'anpassen !!

Gruß
Franz

 Bild

Beiträge aus den Excel-Beispielen zum Thema "TXT Dateien öffnen"