Mein Fehler!
06.05.2004 22:29:42
Damiel
Sorry, neuer Versuch:
Option Explicit
Sub Changes()
Dim rng As Range
Dim c As Integer, maxc ' Anzahl der Spalten
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "ROCs"
Dim wsPos As Worksheet, wsNeg As Worksheet, wsROCs As Worksheet
Set wsPos = Worksheets("Pos")
Set wsNeg = Worksheets("Neg")
Set wsROCs = Worksheets("ROCs")
'Lösche
wsPos.Cells.Delete Shift:=xlUp
wsNeg.Cells.Delete Shift:=xlUp
'Übertrage Erste Spalte und erste Zeile aus Datablatt
Application.CutCopyMode = False
wsPos.Select
wsROCs.Columns("A:A").Copy
wsPos.Range("A1").Select
wsPos.Paste
wsROCs.Rows("1:1").Copy
wsPos.Range("A1").Select
wsPos.Paste
wsPos.Range("A1").Select
maxc = 1
With wsROCs
'Letzte gefüllte Zelle in Zeile 1 (Überschrift) ermitteln
While IsEmpty(.Cells(1, maxc)) = False: maxc = maxc + 1: Wend
If maxc < 2 Then Exit Sub
'Letzte gefüllte Zelle in Spalte "B" ermitteln
lngE = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
For c = 2 To maxc
lngRow = 2
For Each rng In wsROCs.Range(.Cells(2, c), .Cells(lngE, c))
If rng <> "" And rng.Offset(1, 0) <> "" Then
'wenn Zelle in Zeile r und r+1 gefüllt dann
wsPos.Cells(lngRow + 1, c) = (rng.Offset(1, 0) / rng) - 1
lngRow = lngRow + 1 'Zeilenzähler erhöhen
End If
Next rng
Next c
End With
End Sub