Re: Hoffe so ist es ok (bug weg)
01.05.2003 01:33:00
jolly
war noch ein Bug drin....Gruss jolly
Hier der Code
~begin~
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$E$2" And IsNumeric(Target) = True Then
test
End If
End Sub
Private Sub test()
Dim i%, lR%, jahr%, k%
k = 2
lR = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
jahr = Sheets("Tabelle1").Cells(2, 5)
For i = 2 To lR Step 1
If jahr = Sheets("Tabelle1").Cells(i, 1) Then
Sheets("Tabelle1").Cells(k, 7) = Sheets("Tabelle1").Cells(i, 1)
Sheets("Tabelle1").Cells(k, 8) = Sheets("Tabelle1").Cells(i, 2)
Sheets("Tabelle1").Cells(k, 9) = Sheets("Tabelle1").Cells(i, 3)
k = k + 1
End If
Next i
lR = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(k, 7), Cells(lR, 9)).Cells.Delete
lR = Worksheets("Tabelle1").Cells(Rows.Count, 7).End(xlUp).Row
Range(Cells(2, 8), Cells(lR, 9)).Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("$E$2").Select
End Sub