AW: Listenproblem
07.10.2010 15:30:53
welga
Hallo,
eventuell so:
Sub test()
Dim zei As Long
Dim spa As Long
With ThisWorkbook.Sheets(1)
zei = .UsedRange.Rows.Count
spa = .UsedRange.Columns.Count
.Range(Cells(1, 1), Cells(zei, spa)).Copy
End With
Workbooks.Add
Workbooks(2).Activate
ActiveWorkbook.ActiveSheet.Range("A1").Select
ActiveSheet.Paste
ActiveWorkbook.Sheets(1).Sort.SortFields.Clear
ActiveWorkbook.Sheets(1).Sort.SortFields.Add Key:=Range(Cells(1, 1), Cells(zei, 1)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Sheets(1).Sort.SortFields.Add Key:=Range(Cells(1, 7), Cells(zei, 7)) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Sheets(1).Sort
.SetRange Range(Cells(1, 1), Cells(zei, spa))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For i = zei To 2 Step -1
If ActiveWorkbook.Sheets(1).Cells(i - 1, 1) = ActiveWorkbook.Sheets(1).Cells(i, 1) Then _
ActiveWorkbook.Sheets(1).Rows(i).Delete Shift:=xlUp
Next i
ActiveWorkbook.Sheets(1).Sort.SortFields.Clear
ActiveWorkbook.Sheets(1).Sort.SortFields.Add Key:=Range(Cells(1, 7), Cells(zei, 7)) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Sheets(1).Sort
.SetRange Range(Cells(1, 1), Cells(zei, spa))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Columns(7).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=HEUTE()-42"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
Oder einfach mal eine Bsp.-Mappe hochladen