Thema Datum  Von Nutzer Rating
Antwort
23.02.2011 15:45:54 Saubermacher
NotSolved
23.02.2011 21:15:52 Severus
NotSolved
24.02.2011 13:35:16 Gast88214
NotSolved
Blau Mehrere txt in eine Arbeitsmappe einfügen.
24.02.2011 14:33:10 Severus
NotSolved
25.02.2011 10:45:46 Saubermacher
NotSolved
25.02.2011 14:06:57 Severus
NotSolved
28.02.2011 13:57:15 Saubermacher
NotSolved
28.02.2011 16:36:49 Severus
Solved
01.03.2011 11:54:42 Saubermacher
NotSolved
01.03.2011 12:20:19 Severus
NotSolved

Ansicht des Beitrags:
Von:
Severus
Datum:
24.02.2011 14:33:10
Views:
1188
Rating: Antwort:
  Ja
Thema:
Mehrere txt in eine Arbeitsmappe einfügen.

 

Beim Code versuch mal:

Option Explicit 
  
Sub textdateien_uebernehmen() 
Dim lngLaufZahl As Long
Dim strDateiNamen As Variant
Dim trgWB As Excel.Workbook 
Dim tmpWB As Excel.Workbook 
Dim trgWBName As String
Dim bslashPos As Integer
Dim shName As String
  
  
strDateiNamen = Application.GetOpenFilename("Text-Dateien(*.txt*),*.txt*", MultiSelect:=True) 
  
If IsArray(strDateiNamen) Then
    For lngLaufZahl = LBound(strDateiNamen) To UBound(strDateiNamen) 
        If lngLaufZahl = LBound(strDateiNamen) Then
            Set trgWB = Workbooks.Open(Filename:=strDateiNamen(lngLaufZahl)) 
            trgWB.Sheets(1).UsedRange.Columns("A").Select
            'Hier das Trennzeichen ggf. ändern und das Format der einzelnen Spalten als Array definieren 
            Selection.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, semicolon:=True
            For bslashPos = Len(strDateiNamen(lngLaufZahl)) To 1 
                If Mid(strDateiNamen(lngLaufZahl), bslashPos, 1) = "\" Then Exit For
            Next bslashPos 
            shName = strDateiNamen(lngLaufZahl) 
            shName = Right(shName, bslashPos - 1) 
            shName = Left(shName, Len(shName) - 4) 
            trgWB.Sheets(1).Name = shName 
            trgWBName = Application.GetSaveAsFilename(, "Excel-Arbeitsmappe (*.xls),*.xls") 
            trgWB.SaveAs trgWBName, xlWorkbookNormal 
        Else
            Set tmpWB = Workbooks.Open(Filename:=strDateiNamen(lngLaufZahl)) 
            tmpWB.Sheets(1).UsedRange.Columns("A").Select
            Selection.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, semicolon:=True
            For bslashPos = Len(strDateiNamen(lngLaufZahl)) To 1 
                If Mid(strDateiNamen(lngLaufZahl), bslashPos, 1) = "\" Then Exit For
            Next bslashPos 
            shName = strDateiNamen(lngLaufZahl) 
            shName = Right(shName, bslashPos - 1) 
            shName = Left(shName, Len(shName) - 4) 
            tmpWB.Sheets(1).Name = shName 
            tmpWB.Sheets(1).Copy After:=Workbooks(trgWBName).Sheets(trgWB.Sheets.Count) 
            trgWB.Save 
            tmpWB.Close False
            Set tmpWB = Nothing
        End If
    Next lngLaufZahl 
  
Else
    Set trgWB = Workbooks.Open(Filename:=strDateiNamen) 
    trgWB.Sheets(1).UsedRange.Columns("A").Select
    Selection.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, semicolon:=True
    For bslashPos = Len(strDateiNamen) To 1 
        If Mid(strDateiNamen, bslashPos, 1) = "\" Then Exit For
    Next bslashPos 
    shName = strDateiNamen 
    shName = Right(shName, bslashPos - 1) 
    shName = Left(shName, Len(shName) - 4) 
    trgWB.Sheets(1).Name = shName 
    trgWBName = Application.GetSaveAsFilename(, "Excel-Arbeitsmappe (*.xls),*.xls") 
    trgWB.SaveAs trgWBName, xlWorkbookNormal 
End If
Set trgWB = Nothing
End Sub

Was das Trennzeichen betrifft: Hier wird davon ausgegangen, daß der Strichpunkt (Semicolon) als Trennzeichen dient. Wenn das nicht der Fall ist, müßtest Du "semicolon:=True" ersetzen. Bei

  • Leerzeichen durch space:=True
  • Komma durch comma:=True
  • Tabulator durch tab:=True

Die einzelnen Spalten ließen sich vorab als bestimmtes Format definieren:

  • xlGeneralFormat. Allgemein = 0
    xlTextFormat. Text = 1

    xlMDYFormat. Datum im Format MTJ = 2

    xlDMYFormat. Datum im Format TMJ = 3

    xlYMDFormat. Datum im Format JMT = 4

    xlMYDFormat. Datum im Format MJT = 5

    xlDYMFormat. Datum im Format TJM = 6

    xlYDMFormat. Datum im Format JTM = 7

    xlEMDFormat. Datum im EMD-Format = 8

    xlSkipColumn. Spalte überspringen = 9

Die Werte dieser Formate können durch die Integer 0 bis 9 ersetzt werden. Wenn Du also z.B. hinter "semicolon:=True" (wenn Semikolon Dein Trennzeichen ist) einfügst:

FieldInfo:=Array(Array(3, 9), Array(1, 4))

dann wird die Spalte 3 gelöscht (Array(3, 9)) und die Spalte 1 als Datum im Format JJJJ-MM-TT formatiert (Array(1, 4)). Alle anderen Spalten werden im Standardformat übernommen. Textformat für Spalte 2 wäre z.B. Array(2, 1). Wenn Du das nicht brauhst, dann mußt Du auch keine FieldInfo angeben.

Severus


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
23.02.2011 15:45:54 Saubermacher
NotSolved
23.02.2011 21:15:52 Severus
NotSolved
24.02.2011 13:35:16 Gast88214
NotSolved
Blau Mehrere txt in eine Arbeitsmappe einfügen.
24.02.2011 14:33:10 Severus
NotSolved
25.02.2011 10:45:46 Saubermacher
NotSolved
25.02.2011 14:06:57 Severus
NotSolved
28.02.2011 13:57:15 Saubermacher
NotSolved
28.02.2011 16:36:49 Severus
Solved
01.03.2011 11:54:42 Saubermacher
NotSolved
01.03.2011 12:20:19 Severus
NotSolved