Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
824to828
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
824to828
824to828
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Wenn Spalte voll, dann .....
28.11.2006 09:51:07
Frank
Hallo Excelfreunde,
ich habe das folgend Makro im Forum gefunden. Funkktioniert wirklich super bis Spaltenende.
Kann mir jemand das Makro ändern, so das wenn Spalte A voll ist es in Spalte B weiterschreibt und dann in Spalte C u.s.w.
Oder, in eine neues Tabellenblatt in Spalte A u.s.w.
Das Makro hält in dieser Zeile Cells(intRow, intCol) = txt an wenn die Zeile 65536 erreicht wird.
Vielleicht kann mir da jemand helfen.
Besten Dank im Voraus
Gruß Frank

Sub Open_All_Textfiles()
Dim i As Long, TotFiles As Long
Dim intRow As Long, intCol As Integer, txt As String
Dim gefFile As String, dname As String
Dim Suchpfad As String, suchbegriff As String
Dim oldStatus As Variant
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", "D:\Schwimmhalle\Journale\") 'Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.txt")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = False
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For i = 1 To .FoundFiles.Count
gefFile = .FoundFiles(i)
'Hier beginnt dein Code
Open gefFile For Input As #1
Do Until EOF(1)
Line Input #1, txt
intRow = intRow + 1
Do Until txt = ""
intCol = intCol + 1
If InStr(txt, "|") Then
Cells(intRow, intCol) = Left(txt, InStr(txt, "|") - 1)
txt = Right(txt, Len(txt) - InStr(txt, "|"))
Else
Cells(intRow, intCol) = txt
txt = ""
End If
Loop
intCol = 0
Loop
Close #1
'Hier endet dein Code
Next i
End If
End With
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wenn Spalte voll, dann .....
28.11.2006 14:57:08
fcs
Hallo Frank,
mit Änderungen/Ergänzungen in den markierten Zeilen wird jeweils ein neues Blatt begonnen.
Falls du im gleichen Blatt immer die nächste Spalte (B, C usw.) weiter mit Daten auffüllen willst, dann muss du die folgenden Zeilen anpassen/ergänzen

Loop
If intRow = ActiveSheet.Rows.Count Then
intZaehler = intZaehler + 1
intRow = 1
End If
intCol = intZaehler
Loop
Close #1
'Hier endet dein Code

Gruß
Franz

Sub Open_All_Textfiles()
Dim i As Long, TotFiles As Long
Dim intRow As Long, intCol As Integer, txt As String
Dim gefFile As String, dname As String
Dim Suchpfad As String, suchbegriff As String
Dim oldStatus As Variant
Dim wks As Worksheet '###########
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", "D:\Schwimmhalle\Journale\") 'Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.txt")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
Set wks = ActiveSheet '###########
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = False
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For i = 1 To .FoundFiles.Count
gefFile = .FoundFiles(i)
'Hier beginnt dein Code
Open gefFile For Input As #1
Do Until EOF(1)
Line Input #1, txt
intRow = intRow + 1
If intRow > wks.Rows.Count Then '###########
Set wks = Worksheets.Add '###########
intRow = 1 '###########
End If '###########
Do Until txt = ""
intCol = intCol + 1
If InStr(txt, "|") Then
wks.Cells(intRow, intCol) = Left(txt, InStr(txt, "|") - 1) '###########
txt = Right(txt, Len(txt) - InStr(txt, "|"))
Else
wks.Cells(intRow, intCol) = txt '###########
txt = ""
End If
Loop
intCol = 0
Loop
Close #1
'Hier endet dein Code
Next i
End If
End With
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Wenn Spalte voll, dann .....
28.11.2006 19:04:07
Frank
Danke Franz
funktioniert prima.
Nochmals Danke, Danke und Danke
Dir alles Gute
Gruß Frank

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige