AW: Text Zerlegen, Datum Berechnen
18.11.2015 18:45:51
Alex
Hallo Herbert,
trotzdem vielen dank, ich habe das jetzt mit formeln gelöst.
Das mit dem Text Zerlegen habe ich so gelöst, funktioniert mal soweit.
und das mit dem Datum habe ich jetzt so mit der Formel gemacht.
Sub Zerlegen_new()
Dim z As Long
Dim zelle As Range
Dim Zeile As Long, y, x As Long
Dim textteile
Application.DisplayAlerts = False
Worksheets("Tabelle2").Select
Columns(1).TextToColumns _
Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="\"
Columns(4).TextToColumns _
Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="_"
Columns(3).TextToColumns _
Destination:=Range("X1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=True, _
Other:=False, OtherChar:=""
Columns(5).TextToColumns _
Destination:=Range("AB1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="-"
Columns(8).TextToColumns _
Destination:=Range("AH1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="-"
Columns(10).TextToColumns _
Destination:=Range("AJ1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="."
For z = 1 To 6000 'Hier die Anzahl Zeilen angeben
With ActiveSheet
On Error Resume Next
.Hyperlinks.Add .Cells(z, 8), .Cells(z, 1).Value
.Hyperlinks.Add .Cells(z, 34), .Cells(z, 1).Value
End With
Next
Call ERSTELLDATUM_AUSL_DATUM
Application.DisplayAlerts = True
End Sub
Sub ERSTELLDATUM_AUSL_DATUM()
Range("AE2").Select
ActiveCell.FormulaR1C1 = "=KWMonat(RC[-2],RC[-3])"
Selection.AutoFill Destination:=Range("AE2:AE3350"), Type:=xlFillDefault
Range("AD2").Select
ActiveCell.FormulaR1C1 = _
"=DATE(RC[-2],1,1)+RC[-1]*7-WEEKDAY(DATE(RC[-2],1,1),2)+IF(WEEKDAY(DATE(RC[-2],1,1),2)>4,1,-6)"
Selection.AutoFill Destination:=Range("AD2:AD3000"), Type:=xlFillDefault
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[-2])"
Selection.AutoFill Destination:=Range("Z2:Z3000"), Type:=xlFillDefault
Range("AF2").Select
ActiveCell.FormulaR1C1 = "=NETWORKDAYS(RC[-8],RC[-2])"
Selection.AutoFill Destination:=Range("AF2:Af3000"), Type:=xlFillDefault
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=RC[5]/5"
Selection.AutoFill Destination:=Range("AA2:AA3350"), Type:=xlFillDefault
End Sub