VBA- funktioniert nicht
Christian
ich habe in kleines Problem. Eine VBA Programmierung funktioniert unr auf Excel 2007.
Wenn ich es in Excel 2003 starten möchte bringt er folgende Meldung "Objekt unterstützt diese Eigenschaft od. Methode nicht". Vieleicht kann mir jemand den Datensatz umprogrammieren damit ich mein kleines Excel-Programmm auch in 2003 verwenden kann. Ich selbst kenne mich in Sachen programmierung nicht aus.
Sub test()
Dim zei As Long
Dim spa As Long, b As Long
b = 0
ThisWorkbook.Sheets(2).Cells.Delete Shift:=xlUp
With ThisWorkbook.Sheets(1)
.Activate
zei = .Cells(Rows.Count, 1).End(xlUp).Row
spa = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(Cells(5, 1), Cells(zei, spa)).Copy
End With
Sheets(2).Activate
ActiveWorkbook.ActiveSheet.Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Columns("E:G").NumberFormat = "dd/mm/yyyy"
Range("A1:I22").Select
ActiveWorkbook.Worksheets("Ausgabeliste").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Ausgabeliste").Sort.SortFields.Add Key:=Range(Cells(1, 1), Cells( _
zei - 4, 1)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Ausgabeliste").Sort.SortFields.Add Key:=Range( _
Cells(1, 7), Cells(zei - 4, 7)), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Ausgabeliste").Sort
.SetRange Range(Cells(1, 1), Cells(zei - 4, spa))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For i = zei - 4 To 5 Step -1
If ActiveWorkbook.Sheets(2).Cells(i - 1, 1) = ActiveWorkbook.Sheets(2).Cells(i, 1) Then
ActiveWorkbook.Sheets(2).Rows(i).Delete Shift:=xlUp
b = b + 1
End If
Next i
ActiveWorkbook.Worksheets("Ausgabeliste").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Ausgabeliste").Sort.SortFields.Add Key:=Range( _
Cells(1, 7), Cells(zei - 4 - b, 7)), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Ausgabeliste").Sort
.SetRange Range(Cells(1, 1), Cells(zei - 4 - b, 7))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ThisWorkbook.Sheets(1).Activate
ActiveSheet.Rows("1:4").Copy
Sheets("Ausgabeliste").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
For i = 1 To spa
Columns(i).EntireColumn.AutoFit
Next i
With ActiveWorkbook.Sheets(2).Range(Cells(5, 7), Cells(zei - b, 7))
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=HEUTE()-42"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
End Sub