Rangliste per Makro
17.05.2004 08:01:15
Daniel
Ich möchte eine Rangliste erstellen.
Das Problem ist, dass sich die Ausgansdaten verändern und ich daher eine Anpassung der Rangliste an die Datenmenge möchte.
Mir wurde hier im Forum freundlicherweise schon einmal bzgl. eines analogen Problem weitergeholfen. Leider kenne ich mich kaum mit VBA aus, und schaffe es nicht, das analoge Problem auf die neue Situation zu übertragen.
Ich hoffe mir kann nochmal jemand helfen.
Also:
Die Rangliste soll sich per Makro an die Menge (Zeilen und Spalten) der Ausgangsdaten des Blattes "Werte" anpassen.
Für das besse Veständnis habe ich eine Bsp. Datei angehängt.
Das Makro, das analoge Dienste zur Summenberechnung leistet ist folgendes.
(Die Sheets stimmen nicht mit der Beispieldatei überein)
Vielen Dank für Hilfe!
Sub Rechnen()
Dim i%, k%, IntCnt%, LRow%
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Set ws1 = Worksheets("1")
Set ws2 = Worksheets("2")
Set ws3 = Worksheets("3")
Set ws4 = Worksheets("4")
Set ws5 = Worksheets("5")
'Lösche
ws4.Cells.ClearContents
ws5.Cells.ClearContents
'Übertrage Erste Spalte
ws1.Columns("A:A").Copy ws4.Range("A1")
ws2.Columns("A:A").Copy ws5.Range("A1")
ws1.Rows("1:1").Copy ws4.Range("A1")
ws2.Rows("1:1").Copy ws5.Range("A1")
IntCnt = Sheets("Steuerung").Range("A1").Value
With ws1
For j = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
k = 0
LRow = .Cells(Rows.Count, j).End(xlUp).Row
For i = 3 To LRow - IntCnt + 1
k = k + 1
If ws3.Cells(IntCnt + k + 1, 2).Value <> "" Then
'Hier wird die Zelle definiert ,1 heißt A'
ws4.Cells(IntCnt + k + 1, j) = _
Application.Sum(.Range(.Cells(i, j), .Cells(i + IntCnt - 1, j))) * 100 / _
ws3.Cells(IntCnt + k + 1, 2)
End If
Next i
Next j
End With
End Sub
https://www.herber.de/bbs/user/6428.xls