Datei wächst wegen Formeln

Sub Makro2() 'gehe zu Tab1 Sheets("Tab1").Select 'Formle Range("C1").Select: ActiveCell.FormulaR1C1 = "=IF((LEFT(RC[-2],9))="" .mehmet"",""ja"","""")" Range("D1").Select: ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""ja"",R[1]C[-3],"""")" Range("E1").Select: ActiveCell.FormulaR1C1 = "=IF(RC[-2]=""ja"",R[2]C[-4],"""")" Range("F1").Select: ActiveCell.FormulaR1C1 = "=IF(RC[-3]=""ja"",R[3]C[-5],"""")" Range("G1").Select: ActiveCell.FormulaR1C1 = "=IF(RC[-4]=""ja"",R[4]C[-6],"""")" Range("H1").Select: ActiveCell.FormulaR1C1 = "=IF(RC[-5]=""ja"",R[5]C[-7],"""")" 'Markiere und ziehe runter Range("C1:H1").Select: Selection.AutoFill Destination:=Range("C1:H65536"), Type:=xlFillDefault 'Range("C1:H130").Select 'gehe wieder nach oben Range("C1").Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ja, es wird eingelsen. Eine Text Datei. Ich habe mit Makro so aufgezeichnet:


Sub Text_Einlesen_1()
Sheets("tab1").Select: Cells.Select: Selection.delete Shift:=xlUp: Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Dokumente und Einstellungen\Mehmet\Desktop\14may07.txt", _
Destination:=Range("A1"))
.Name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2)
.Refresh BackgroundQuery:=False
End With
Cells.Select: Selection.ClearFormats: Range("A1").Select 'Formate löschen wegen Dateigrösse
End Sub

Sub Text_Einlesen_1() Sheets("tab1").Select Cells.Clear With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Dokumente und Einstellungen\Mehmet\Desktop\14may07.txt", _ Destination:=Range("A1")) .Name = "" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = False .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 850 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(2) .Refresh BackgroundQuery:=False End With Cells.ClearFormats: Range("A1").Select 'Formate löschen wegen Dateigrösse '

Sub Text_Backup_3_Leere_C_Spalten_Loeschen() Dim i As Long Application.ScreenUpdating = False 'For i = 65536 To 1 Step -1 For i = 30000 To 1 Step -1 If Cells(i, 3).Value "ja" Then Rows(i).Delete End If Next i Application.ScreenUpdating = True End Sub

Sub Text_Backup_3_Leere_C_Spalten_Loeschen() Const sp = 3 'ab letzter nichtleerer Zelle in Spalte [sp] Dim i As Long Dim lz As Long lz = Rows.Count If Cells(lz, sp) = "" Then lz = Cells(Rows.Count, sp).End(xlUp).Row Application.ScreenUpdating = False For i = lz To 1 Step -1 If Cells(i, 3).Value "ja" Then Rows(i).Delete End If Next i Application.ScreenUpdating = True End Sub

Sub test() Dim r1 As Range, r2 As Range Dim x As Long, z1 As Long, z2 As Long Set r1 = Range("C:C").Find(After:=Range("C1"), What:="ja", LookIn:=xlValues, LookAt:=xlWhole, _ Searchdirection:=xlPrevious) If r1 Is Nothing Then Exit Sub x = r1.Row Do Set r2 = Range("C:C").Find(After:=r1, What:="ja", LookIn:=xlValues, LookAt:=xlWhole, _ Searchdirection:=xlPrevious) If r2.Row = x Then Exit Do z1 = r2.Row + 1: z2 = r1.Row - 1 Debug.Print z1, z2 If z1 2 End Sub

Beliebteste Forumthreads (12 Monate)

20 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread