Ok ich krieg nun wircklich alles so hin wie ich will bis auf diese dämliche umstellung von Text auf Nummer (Double wäre glaub ideal)
Public Sub Abrechnung()
' loadInput
Dim filename As String
Dim wks As Worksheet
filename = "C:\Temp\TEST-PCOUNTER.txt"
Sheets("Tabelle1").Select
Set wks = ActiveSheet
With wks.QueryTables.Add(Connection:="TEXT;" & filename, Destination:=wks.Range("$A$1"))
.Name = "LogQuery"
.RefreshStyle = xlInsertDeleteCells
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
' addFilter()
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("1:1").Select
Selection.AutoFilter
Range("B1").Select
ActiveSheet.Range("$A$1:$N$285").AutoFilter Field:=2, Criteria1:="=*Deposit:*", Operator:=xlOr
'copyRows()
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle2").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle1").Select
Columns("D:E").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle2").Select
Columns("B:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle1").Select
Columns("M:M").Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("M1:M300").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle2").Select
Columns("D:D").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Formatieren()
Columns("A:A").Select
Application.CutCopyMode = False
Selection.NumberFormat = "@"
Columns("B:B").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("C:C").Select
Selection.NumberFormat = "h:mm;@"
Columns("D:D").Select
Selection.NumberFormat = "#,##0.00 €"
Range("D7").Select
' addSumme()
Range("E2").Select
Selection.NumberFormat = "#,##0.00 €"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveCell.FormulaR1C1 = "=SUM(C[-1])"
' addTitel()
Range("A1").Select
ActiveCell.FormulaR1C1 = "Auflader"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Datum"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Uhrzeit"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Betrag"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Summe"
Cells.EntireColumn.AutoFit
Range("A1:E1").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' saveFile()
ChDir "C:\Temp"
ActiveWorkbook.SaveAs filename:="C:\Temp\" & "Abrechnung_" & Format(Date$, "dd.mm.yy") & ".xls"
End Sub
Das ist mein Code und die Lopgfile
DHBW-HEIDENHEIM\cakar,C:\Users\cakar\AppData\Local\Temp\29\CampusNet\tmp_Default_010820111546_343445251839818CAKAR@DHBW-LOCALDHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:33,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E3915E4/ID=305,66017,1,0.10,0.00
DHBW-HEIDENHEIM\e-jg8439,Deposit: A01-03/08/2011-11:35:59-3,NT-AUTORITÄT\SYSTEM,03/08/2011,11:36,\\PR-EDU,,,,/Ts=4E39169E,,,3.00,3.21
DHBW-HEIDENHEIM\durner,Microsoft Word - Zulassung an Firma DHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:37,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E3916F0/ID=306,66975,1,0.10,0.00
DHBW-HEIDENHEIM\durner,Microsoft Word - Zulassung an Student DHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:38,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E391704/ID=307,67185,1,0.10,0.00
DHBW-HEIDENHEIM\durner,Microsoft Word - Zulassung an Student DHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:38,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E391715/ID=308,67635,1,0.10,0.00
DHBW-HEIDENHEIM\durner,Microsoft Word - Zulassung an Firma DHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:38,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E39171C/ID=309,68048,1,0.10,0.00
DHBW-HEIDENHEIM\durner,Microsoft Word - Zulassung an Firma DHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:38,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E391726/ID=30A,67118,1,0.10,0.00
DHBW-HEIDENHEIM\durner,Microsoft Word - Zulassung an Student DHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:38,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E391730/ID=30B,67313,1,0.10,0.00
DHBW-HEIDENHEIM\durner,Microsoft Word - Zulassung an Student DHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:39,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E391737/ID=30C,66463,1,0.10,0.00
DHBW-HEIDENHEIM\durner,Microsoft Word - Zulassung an Firma DHBW.doc,\\PR-STAFF\sm110pr01,03/08/2011,11:39,\\sm110pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E39173E/ID=30D,67896,1,0.10,0.00
DHBW-HEIDENHEIM\e-jg8439,Copier job,\\PR-EDU\ew331pr01,03/08/2011,11:39:27,,,,A4,/Jt=101/Cp=1/Ts=4E39174F,0,10,0.30,2.91
DHBW-HEIDENHEIM\e-jg8439,Copier job,\\PR-EDU\ew331pr01,03/08/2011,11:41:17,,,,A4,/Jt=101/Cp=1/Ts=4E3917BD,0,6,0.18,2.73
DHBW-HEIDENHEIM\thanel,Re: Antrag Fristverlängerung Bachelorarbeit,\\PR-STAFF\sm310pr01,03/08/2011,11:41,\\sm310pc02,,,A4,/C/Jt=4/Cp=1/Ts=4E3917B8/ID=30E,92309,2,0.20,0.00
DHBW-HEIDENHEIM\malzahn,pdfreport.php.pdf,\\PR-STAFF\sm211pr01,03/08/2011,11:42,\
|