Dateiimport über Dialog

[Vince440]

Hi,

ich habe folgendes Problem:

Ich habe eine Mappe mit 3 Tabellenblättern.
Im ersten Blatt Teil1 sollen die Daten von txtfile1 sowie im zweiten Blatt Teil2 die Daten von txtfile2 importiert werden. Das dritte Blatt arbeitet mit Referenzierungen und ist eine Kombination der ersten beiden.

Da sich innerhalb der txtfiles Semikolons zum Trennen befinden, muss das beim Import voreingestellt sein, dass nur dadurch und nicht durch Tabulator getrennt wird. Außerdem muss es Windows (ANSI)-Format haben.

Ich möchte nun ein Makro erstellen, welches mir einen Datei-Dialog öffnet und NUR die Daten aus txtfile1 IMMER in Tabellenblatt Teil1 einfügt. Für txtfile2 gilt dann das gleiche mit Teil2, dafür will dann ein eigenes Makro machen, da nicht immer alle txtfiles vorliegend sind, bzw. aktuelle Daten nicht geändert werden sollen, solange kein txtfile reinkommt.

Der Dateipfad ist natürlich nicht immer gleich, daher die Auswahl über den Dialog.

Wie kann ich das umsetzen? :(

Bin über Tips dankbar

analog
http://www.ms-office-forum.net/forum/sho...ost1752176

[schauan]

Hallo Vince,

Du musst nicht jede Frage gleich innerhalb weniger Minuten in mehreren Foren posten. Dass wir hier crossposting nicht verbieten ist keineswegs ein Freibrief für massives Ausnutzen unserer Kulanz dieses Thema betreffend. Man sollte den Antwortern in einem Forum schon mal m.E. um die zwei Stunden Zeit geben, wobei die Meinungen dazu auch etwas auseinander gehen.

Schaue erst mal, was in dieser Frage der Makrorekorder leistet und stelle den Code zur Verbesserung dann ein.

[Vince440]

Hi,

hier mal mein Einstieg.

Mein Problem liegt explizit darin, dass ich 1. keinen Dialog hinbekomme und 2. unabhängig vom Tabellenblatt arbeiten will. Dh. die Ausführung meiner Makros ist immer Tabellenblatt-gebunden, was mega nervt.

Ich stelle mir beim Gesamtblatt Tablet bspw. für jedes Einzelblatt Teil1, Teil2,... einen Button vor. Bei Betätigen z.B. des ERSTEN Buttons öffnet sich ein Dialog zur Auswahl einer txt-Datei in das Tabellenblatt Teil1. Der txt-Import soll als Windows ANSI, Spaltentrennung über Semikolon und Datenformat: Text erfolgen. Betätigung des ZWEITEN Buttons löst einen Dialog für ein Txt-File für das Tabellenblatt Teil2.

Ich habe mal eine Excel für die Struktur inkl. des bisherigen Makros angefügt...

Kann mir jmd dabei helfen?

Danke

Vince

[Vince440]

Hi,

also habe jetzt ungefähr gefunden, was ich suche. Wer kann mir den Code so kombinieren, dass zum einen die txt-Datei korrekt formatiert importiert wird und das die neue Datei nicht in einem neuen Excel-file geöffnet wird, sonder direkt an die richtige Stelle (Teil1) gesetzt wird.

Anbei der Code:

Code:

Sub neu()
Dim ImportDatei As Variant
Dim wbImport As Workbook

ImportDatei = Application.GetOpenFilename(FileFilter:="Microsoft txt-Dateien (*.txt), *.txt", Title:="Eine Datei auswählen")

If ImportDatei = False Then Exit Sub

Set wbImport = Workbooks.Open(ImportDatei)

wbImport.Worksheets("Zusammenfassung").UsedRange.Copy
ThisWorkbook.Worksheets("Import1").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

wbImport.Close savechanges:=False
Set wbImport = Nothing

End Sub

sowie

Code:

Sub Import_txt1()

'
' Import_txt1 Makro
'
   Sheets("Teil1").Select
   Sheets("Teil1").Name = "Teil1"
   Range("A1").Select
   With ActiveSheet.QueryTables.Add(Connection:= _
       "TEXT;C:\Users\Vince\Desktop\Tablet Drawing\Teil1.txt", Destination:=Range( _
       "$A$1"))
       .Name = "Teil1"
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .TextFilePromptOnRefresh = False
       .TextFilePlatform = 1252
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = False
       .TextFileSemicolonDelimiter = True
       .TextFileCommaDelimiter = False
       .TextFileSpaceDelimiter = False
       .TextFileColumnDataTypes = Array(2)
       .TextFileTrailingMinusNumbers = True
       .Refresh BackgroundQuery:=False
   End With
   Sheets("Tablet").Select
   ActiveWorkbook.Save
End Sub

Gruß

Vince

[Kuwer]

Hallo,

vielleicht so:

Sub Import_txt1()
'
' Import_txt1 Makro
'
 Dim strDatei As String
 strDatei = Application.GetOpenFilename("Textdateien (*.txt), *.txt")
 If Not CVar(strDatei) = False Then
   With Worksheets("Teil1")
     Do While .QueryTables.Count
       .QueryTables(1).Delete
     Loop
     .Cells.Delete
     With .QueryTables.Add(Connection:="TEXT;" & strDatei, Destination:=.Range("$A$1"))
       .Name = "Teil1"
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .RefreshStyle = xlOverwriteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .TextFilePromptOnRefresh = False
       .TextFilePlatform = 1252
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = False
       .TextFileSemicolonDelimiter = True
       .TextFileCommaDelimiter = False
       .TextFileSpaceDelimiter = False
       .TextFileTrailingMinusNumbers = True
       .Refresh BackgroundQuery:=False
     End With
   End With
   ActiveWorkbook.Save
 End If
End Sub

Gruß Uwe

[Vince440]

Hi Ralf, danke schon mal.

wie kann ich in dem bisherigen Makro die Leerzeilen in dem Tabellelblatt löschen, in welche ich das neue txt eingefügt habe, wie in diesem Makro?

Code:

Sub DelEmptyLines()
   Dim i As Long  ' Zeilenzähler
   Application.ScreenUpdating = False  ' Bildschirmausgaben abschalten
   For i = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row _
       To 1 Step -1
           If Application.WorksheetFunction.CountA(Rows(i)) = 0 _
       Then Rows(i).Delete
           If i Mod 100 = 0 Then Application.StatusBar = i
   Next
   Application.StatusBar = False ' Statuszeile wieder ans Excel zurückgeben
   Application.ScreenUpdating = True ' Bildschirmausgaben einschalten
End Sub

Außerdem hätte ich gerne in den Spalten A, B und C eine Löschung sämtlicher Sonderzeichen wie mit diesem Makro:

Code:

Public Sub Zeichenloeschung()
Dim i As Long
Dim Start As String
Dim Ende As String
Dim Temp As String
Dim erlaubt As String
Start = Time ' <- hier wird eine Zeitmessung eingeleitet
erlaubt = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!§$%&/[]()=?*#ß\ÄÖÜ@,-_:.+;<>°'"""
' Groß-/Kleinschreibung wird ignoriert
Application.ScreenUpdating = False ' Bildschirm-Aktualisierung wird hier deaktiviert;
' Ansonsten dauert der Vorgang noch ein wenig länger, da er sonst jede Änderung sofort anzeigt
   For Each C In Selection
       With C
           Temp = ""
           For i = 1 To Len(.Text)
               If InStr(1, erlaubt, Mid(.Text, i, 1), vbTextCompare) > 0 Then
                   Temp = Temp & Mid(.Text, i, 1)
               End If
           Next i
           .Value = Temp
       End With
       Next C
Application.ScreenUpdating = True ' Jetzt wird die Anzeige wieder aktualisiert
Ende = Time ' <- hier wird die Zeitmessung gestoppt
End Sub

Dazu würde ich gerne noch die Spalten D und E genauso von Sonderzeichen SOWIE Leerzeichen (also mit " " ) bzw. nicht erlaubten Sonderzeichen wie mit dem folgenden Makro befreien (fast das gleiche wie oben).

Code:

Public Sub Zeichenloeschung()
Dim i As Long
Dim Start As String
Dim Ende As String
Dim Temp As String
Dim erlaubt As String
Start = Time ' <- hier wird eine Zeitmessung eingeleitet
erlaubt = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!§$%&/[]()=?*#ß\ÄÖÜ@,-_:.+;<> °'"""
' Groß-/Kleinschreibung wird ignoriert
Application.ScreenUpdating = False ' Bildschirm-Aktualisierung wird hier deaktiviert;
' Ansonsten dauert der Vorgang noch ein wenig länger, da er sonst jede Änderung sofort anzeigt
   For Each C In Selection
       With C
           Temp = ""
           For i = 1 To Len(.Text)
               If InStr(1, erlaubt, Mid(.Text, i, 1), vbTextCompare) > 0 Then
                   Temp = Temp & Mid(.Text, i, 1)
               End If
           Next i
           .Value = Temp
       End With
       Next C
Application.ScreenUpdating = True ' Jetzt wird die Anzeige wieder aktualisiert
Ende = Time ' <- hier wird die Zeitmessung gestoppt
End Sub

Wie wähle ich die zugehörigen Spalten aus?

[Vince440]

Ich habe dazu auch noch das Problem, dass meine Bezüge aus dem Gesamtblatt also wo alle einzelnen Blätter zusammenlaufen nach der Ausführung deines Makros kaputt gehen und nicht mehr funktionieren. Wieso ist das so und wie kann ich das verhindern? Es kommt ja augenscheinlich daher, dass ich etwas importiere und dann eben nichts zum verweisen vorhanden ist.

[Kuwer]

Hallo,

ich bin zwar nicht der Ralf, aber hätte noch folgenden Vorschlag.
Da Du ja Querytables hast, genügt ja ein Refresh mit Dateiabfrage.

Sub Import_txt1()
'
' Import_txt1 Makro
'
 With Sheets("Teil1").QueryTables(1)
   .TextFilePromptOnRefresh = True
   On Error Resume Next
   .Refresh
   On Error GoTo 0
 End With
 ActiveWorkbook.Save
End Sub

Gruß Uwe

[Vince440]

oh sry uwe da hab ich mich vertan!

dein letzter Vorschlag hat sehr gut funktioniert!
danke vielmals! :18: :18:

Kannst du mir dort noch die Auswahl der Spalten A bis C und der Anwendung der Sonderzeichenlöschung (Leerzeichen nur links und rechts von Anfang/Ende löschen, keine Sonderzeichen, sonst nur erlaubte) sowie die Auwahl der Spalten D und E mit der Anwendung der Zeichenlöschung (keine Leerzeichen, keine Sonderzeichen, nur erlaubte) einbinden, s.u.?

[Kuwer]

Hallo,

im Prinzip dann so:

Public Sub Zeichenloeschung()
Dim i As Long
Dim Start As String
Dim Ende As String
Dim Temp As String
Dim erlaubt As String
Start = Time ' <- hier wird eine Zeitmessung eingeleitet
erlaubt = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!§$%&/[]()=?*#ß\ÄÖÜ@,-_:.+;<>°'"""
' Groß-/Kleinschreibung wird ignoriert
Application.ScreenUpdating = False ' Bildschirm-Aktualisierung wird hier deaktiviert;
' Ansonsten dauert der Vorgang noch ein wenig länger, da er sonst jede Änderung sofort anzeigt
  'For Each C In Selection
  For Each C In Application.Intersect(Sheets("Teil1").Columns("A:C"), Sheets("Teil1").UsedRange)
      With C
          Temp = ""
          For i = 1 To Len(.Text)
              If InStr(1, erlaubt, Mid(.Text, i, 1), vbTextCompare) > 0 Then
                  Temp = Temp & Mid(.Text, i, 1)
              End If
          Next i
          .Value = Temp
      End With
      Next C
Application.ScreenUpdating = True ' Jetzt wird die Anzeige wieder aktualisiert
Ende = Time ' <- hier wird die Zeitmessung gestoppt
End Sub

Das rufst du dann einfach im Makro mit auf:

Sub Import_txt1()
'
' Import_txt1 Makro
'
With Sheets("Teil1").QueryTables(1)
  .TextFilePromptOnRefresh = True
  On Error Resume Next
  .Refresh
  On Error GoTo 0
End With
Zeichenloeschung
ActiveWorkbook.Save
End Sub

Gruß Uwe