Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
VBA Code Textdatei
27.01.2013 16:22:02
Peter

Hallo,
ich möchte die Textdatei in der „Tabelle2“ ab der Zelle „C2“ einfügen. Es sollen
10 Zeilen oberhalb und 2 Spalten links neben den eingefügten Daten frei bleiben.
Wer kann helfen den VBA Code so zu verändern ?
Danke im voraus
Peter
Sub AusTextDatei()
Application.ScreenUpdating = False
'Import in Exceltabelle
Dim intRow As Integer, intCol As Integer
Dim strTxt As String, sFile As String
Dim ZSh As Worksheet
Set ZSh = Worksheets("Tabelle2")
ZSh.Range("A1").CurrentRegion.ClearContents
'----------------Speicherort der Textdatei---------------------
sFile = "C:\Users\Master\Documents\Testordner\TxtTest.txt"
If Dir(sFile) = "" Then
Beep
MsgBox "Die Textdatei " & sFile & " existiert nicht!", vbCritical
Exit Sub
End If
Close
Open sFile For Input As #1
Do Until EOF(1)
intRow = intRow + 1
intCol = 0
Line Input #1, strTxt
Do Until InStr(strTxt, ",") = 0
intCol = intCol + 1
ZSh.Cells(intRow, intCol) = Left(strTxt, InStr(strTxt, ",") - 1)
strTxt = Right(strTxt, Len(strTxt) - InStr(strTxt, ","))
Loop
ZSh.Cells(intRow, intCol + 1) = strTxt
Loop
Close
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Code Textdatei
27.01.2013 16:47:03
Matze
Hallo Peter,
also ab e12 einfügen wenn oberhalb c2 10 Zeilen u. 2 spalten frei bleiben sollen?
Matze

AW: VBA Code Textdatei
27.01.2013 16:58:37
peter
Hallo Matze,
ab "C11"
Gruß peter

AW: VBA Code Textdatei
27.01.2013 17:11:06
Matze
Option Explicit
Sub AusTextDatei()
Application.ScreenUpdating = False
'Import in Exceltabelle
Dim intRow As Integer, intCol As Integer
Dim strTxt As String, sFile As String
Dim ZSh As Worksheet
Set ZSh = Worksheets("Tabelle2")
ZSh.Range("A1").CurrentRegion.ClearContents
'----------------Speicherort der Textdatei---------------------
sFile = "C:\Testordner\TxtTest.txt"
If Dir(sFile) = "" Then
Beep
MsgBox "Die Textdatei " & sFile & " existiert nicht!", vbCritical
Exit Sub
End If
Close
Open sFile For Input As #1
Do Until EOF(1)
intRow = intRow + 1
intCol = 2 'Spalte C
Line Input #1, strTxt
Do Until InStr(strTxt, ",") = 0
intCol = intCol + 1
ZSh.Cells(intRow + 1, intCol) = Left(strTxt, InStr(strTxt, ",") - 1)
strTxt = Right(strTxt, Len(strTxt) - InStr(strTxt, ","))
Loop
ZSh.Cells(intRow + 10, intCol + 1) = strTxt
Loop
Close
End Sub

Anzeige
Korrektur wegen ClearContents
27.01.2013 17:15:59
Matze
ZSh.Range("A1").CurrentRegion.ClearContents
ersetzen
ZSh.Range("C:C").CurrentRegion.ClearContents ' löscht Spalte c

AW:funkt. leider noch nicht
27.01.2013 18:08:24
peter
Hallo Matze,
erstmal Danke für Deine schnelle Hilfe.
Die 2 freien Spalten liegen jetzt vor.
Leider sind immer noch keine
10 freien Zeilen oberhalb der
Einfügeposition ("C11")vorhanden.
Peter

AW: AW:funkt. leider noch nicht
27.01.2013 18:18:07
Matze
hallo Peter,
Habe hier eine Zip gemacht Pfad der 2 Dateien = C:\Testordner
https://www.herber.de/bbs/user/83607.zip
bei mir funktioniert das , kenne den Aufbau deiner Datei nicht und auch nicht ob du weitere Codezeilen verwendest.
Matze

Anzeige
AW: Danke- so funktioniert es
27.01.2013 18:31:26
Peter
Hallo Matze,
erstmal nochmal Danke.
So funktioniert mein vorhaben.
Aber ob die Sache sauber in VBA programmiert ist ?
Peter
Sub AusTextDatei()
Application.ScreenUpdating = False
'Import in Exceltabelle
Dim intRow As Integer, intCol As Integer
Dim strTxt As String, sFile As String
Dim ZSh As Worksheet
Set ZSh = Worksheets("Tabelle2")
ZSh.Range("A1").CurrentRegion.ClearContents
'###############################################
'----------------Speicherort der Textdatei---------------------
sFile = "C:\Users\Master\Documents\Testordner\TxtTest.txt"
'###############################################
If Dir(sFile) = "" Then
Beep
MsgBox "Die Textdatei " & sFile & " existiert nicht!", vbCritical
Exit Sub
End If
Close
Open sFile For Input As #1
Do Until EOF(1)
intRow = intRow + 1
intCol = 2 'Spalte C
Line Input #1, strTxt
Do Until InStr(strTxt, ",") = 0
intCol = intCol + 1
ZSh.Cells((intRow + 9) + 1, intCol) = Left(strTxt, InStr(strTxt, ",") - 1)
strTxt = Right(strTxt, Len(strTxt) - InStr(strTxt, ","))
Loop
ZSh.Cells(intRow + 9, intCol + 1) = strTxt
Loop
Close

Anzeige
AW: Danke- so funktioniert es
27.01.2013 18:50:53
Matze

Sub AusTextDatei() 'Import in Exceltabelle
Dim intRow As Integer, intCol As Integer
Dim strTxt As String, sFile As String
Dim ZSh As Worksheet
Set ZSh = Worksheets("Tabelle2")
ZSh.Range("C:C").ClearContents 'löscht komplette Spalte C
sFile = "C:\Users\Master\Documents\Testordner\TxtTest.txt"
If Dir(sFile) = "" Then
MsgBox "Die Textdatei " & sFile & " existiert nicht!", vbCritical
Exit Sub
End If
Open sFile For Input As #1
Do Until EOF(1)
intRow = intRow + 1
intCol = 2 'ANPASSEN 2 = Spalte C
Line Input #1, strTxt
Do Until InStr(strTxt, ",") = 0
intCol = intCol + 1
ZSh.Cells((intRow + 1) + 1, intCol) = Left(strTxt, InStr(strTxt, ",") - 1)
strTxt = Right(strTxt, Len(strTxt) - InStr(strTxt, ","))
Loop
ZSh.Cells(intRow + 9, intCol + 1) = strTxt 'Start in 9 = ZEILE 10
Loop
Close
End Sub

Anzeige

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige